{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- | This module provides a direct (as opposed to 'Cooked.MockChain.Staged')
-- implementation of the `MonadBlockChain` specification. This rely on the
-- emulator from cardano-node-emulator for transaction validation, although we
-- have our own internal state. This choice might be revised in the future.
module Cooked.MockChain.Direct 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.Applicative
import Control.Lens qualified as Lens
import Control.Monad
import Control.Monad.Except
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Monad.State.Strict
import Control.Monad.Writer
import Cooked.InitialDistribution
import Cooked.MockChain.AutoFilling
import Cooked.MockChain.Balancing
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Body
import Cooked.MockChain.GenerateTx.Output
import Cooked.MockChain.GenerateTx.Witness
import Cooked.MockChain.MockChainState
import Cooked.MockChain.UtxoState (UtxoState)
import Cooked.Pretty.Hashable
import Cooked.Skeleton
import Data.Coerce
import Data.Default
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Ledger.Index qualified as Ledger
import Ledger.Orphans ()
import Ledger.Tx qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api

-- * Direct Emulation

-- $mockchaindocstr
--
-- The MockChainT monad provides a direct emulator; that is, it gives us a
-- simple way to run a full validation process directly, without relying on a
-- deployed node. While simulated, the validation is performed by the
-- cardano-ledger code, thus ensuring similar results on the real chain.
--
-- A 'MockChain':
--
-- - stores and updates a 'MockChainState'
--
-- - returns a 'UtxoState' when run
--
-- - emits entries in a 'MockChainBook'

-- | This represents elements that can be emitted throughout a 'MockChain'
-- run. These elements are either log entries corresponding to internal events
-- worth logging, or aliases for hashables corresponding to elements users
-- wishes to be properly displayed when printed with
-- 'Cooked.Pretty.Class.PrettyCooked'
data MockChainBook where
  MockChainBook ::
    { -- | Log entries generated by cooked-validators
      MockChainBook -> [MockChainLogEntry]
mcbJournal :: [MockChainLogEntry],
      -- | Aliases stored by the user
      MockChainBook -> Map BuiltinByteString String
mcbAliases :: Map Api.BuiltinByteString String
    } ->
    MockChainBook

instance Semigroup MockChainBook where
  MockChainBook [MockChainLogEntry]
j Map BuiltinByteString String
a <> :: MockChainBook -> MockChainBook -> MockChainBook
<> MockChainBook [MockChainLogEntry]
j' Map BuiltinByteString String
a' = [MockChainLogEntry]
-> Map BuiltinByteString String -> MockChainBook
MockChainBook ([MockChainLogEntry]
j [MockChainLogEntry] -> [MockChainLogEntry] -> [MockChainLogEntry]
forall a. Semigroup a => a -> a -> a
<> [MockChainLogEntry]
j') (Map BuiltinByteString String
a Map BuiltinByteString String
-> Map BuiltinByteString String -> Map BuiltinByteString String
forall a. Semigroup a => a -> a -> a
<> Map BuiltinByteString String
a')

instance Monoid MockChainBook where
  mempty :: MockChainBook
mempty = [MockChainLogEntry]
-> Map BuiltinByteString String -> MockChainBook
MockChainBook [MockChainLogEntry]
forall a. Monoid a => a
mempty Map BuiltinByteString String
forall a. Monoid a => a
mempty

-- | A 'MockChainT' builds up a stack of monads on top of a given monad @m@ to
-- reflect the requirements of the simulation. It writes a 'MockChainBook',
-- updates and reads from a 'MockChainState' and throws possible
-- 'MockChainError's.
newtype MockChainT m a = MockChainT
  {forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain :: (ExceptT MockChainError (StateT MockChainState (WriterT MockChainBook m))) a}
  deriving newtype
    ( (forall a b. (a -> b) -> MockChainT m a -> MockChainT m b)
-> (forall a b. a -> MockChainT m b -> MockChainT m a)
-> Functor (MockChainT m)
forall a b. a -> MockChainT m b -> MockChainT m a
forall a b. (a -> b) -> MockChainT m a -> MockChainT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MockChainT m b -> MockChainT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockChainT m a -> MockChainT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockChainT m a -> MockChainT m b
fmap :: forall a b. (a -> b) -> MockChainT m a -> MockChainT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MockChainT m b -> MockChainT m a
<$ :: forall a b. a -> MockChainT m b -> MockChainT m a
Functor,
      Functor (MockChainT m)
Functor (MockChainT m) =>
(forall a. a -> MockChainT m a)
-> (forall a b.
    MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b)
-> (forall a b c.
    (a -> b -> c)
    -> MockChainT m a -> MockChainT m b -> MockChainT m c)
-> (forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b)
-> (forall a b. MockChainT m a -> MockChainT m b -> MockChainT m a)
-> Applicative (MockChainT m)
forall a. a -> MockChainT m a
forall a b. MockChainT m a -> MockChainT m b -> MockChainT m a
forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b
forall a b.
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b
forall a b c.
(a -> b -> c) -> MockChainT m a -> MockChainT m b -> MockChainT m c
forall (m :: * -> *). Monad m => Functor (MockChainT m)
forall (m :: * -> *) a. Monad m => a -> MockChainT m a
forall (m :: * -> *) a b.
Monad m =>
MockChainT m a -> MockChainT m b -> MockChainT m a
forall (m :: * -> *) a b.
Monad m =>
MockChainT m a -> MockChainT m b -> MockChainT m b
forall (m :: * -> *) a b.
Monad m =>
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MockChainT m a -> MockChainT m b -> MockChainT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> MockChainT m a
pure :: forall a. a -> MockChainT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b
<*> :: forall a b.
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MockChainT m a -> MockChainT m b -> MockChainT m c
liftA2 :: forall a b c.
(a -> b -> c) -> MockChainT m a -> MockChainT m b -> MockChainT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
MockChainT m a -> MockChainT m b -> MockChainT m b
*> :: forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
MockChainT m a -> MockChainT m b -> MockChainT m a
<* :: forall a b. MockChainT m a -> MockChainT m b -> MockChainT m a
Applicative,
      MonadState MockChainState,
      MonadError MockChainError,
      MonadWriter MockChainBook
    )

-- | Our 'MockChain' naturally instantiate the inner monad with 'Identity'
type MockChain = MockChainT Identity

-- | Custom monad instance made to increase the slot count automatically
instance (Monad m) => Monad (MockChainT m) where
  return :: forall a. a -> MockChainT m a
return = a -> MockChainT m a
forall a. a -> MockChainT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  MockChainT ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
x >>= :: forall a b.
MockChainT m a -> (a -> MockChainT m b) -> MockChainT m b
>>= a -> MockChainT m b
f = ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
-> MockChainT m b
forall (m :: * -> *) a.
ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (ExceptT
   MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
 -> MockChainT m b)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
-> MockChainT m b
forall a b. (a -> b) -> a -> b
$ ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
x ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> (a
    -> ExceptT
         MockChainError (StateT MockChainState (WriterT MockChainBook m)) b)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
forall a b.
ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> (a
    -> ExceptT
         MockChainError (StateT MockChainState (WriterT MockChainBook m)) b)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MockChainT m b
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain (MockChainT m b
 -> ExceptT
      MockChainError (StateT MockChainState (WriterT MockChainBook m)) b)
-> (a -> MockChainT m b)
-> a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MockChainT m b
f

instance (Monad m) => MonadFail (MockChainT m) where
  fail :: forall a. String -> MockChainT m a
fail = MockChainError -> MockChainT m a
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m a)
-> (String -> MockChainError) -> String -> MockChainT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MockChainError
FailWith

instance MonadTrans MockChainT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> MockChainT m a
lift = ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
forall (m :: * -> *) a.
ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (ExceptT
   MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
 -> MockChainT m a)
-> (m a
    -> ExceptT
         MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> m a
-> MockChainT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT MockChainState (WriterT MockChainBook m) a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT MockChainError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MockChainState (WriterT MockChainBook m) a
 -> ExceptT
      MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> (m a -> StateT MockChainState (WriterT MockChainBook m) a)
-> m a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT MockChainBook m a
-> StateT MockChainState (WriterT MockChainBook m) a
forall (m :: * -> *) a. Monad m => m a -> StateT MockChainState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT MockChainBook m a
 -> StateT MockChainState (WriterT MockChainBook m) a)
-> (m a -> WriterT MockChainBook m a)
-> m a
-> StateT MockChainState (WriterT MockChainBook m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> WriterT MockChainBook m a
forall (m :: * -> *) a. Monad m => m a -> WriterT MockChainBook m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (Monad m, Alternative m) => Alternative (MockChainT m) where
  empty :: forall a. MockChainT m a
empty = ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
forall (m :: * -> *) a.
ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (ExceptT
   MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
 -> MockChainT m a)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT
   MockChainState (WriterT MockChainBook m) (Either MockChainError a)
 -> ExceptT
      MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall a b. (a -> b) -> a -> b
$ (MockChainState
 -> WriterT
      MockChainBook m (Either MockChainError a, MockChainState))
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((MockChainState
  -> WriterT
       MockChainBook m (Either MockChainError a, MockChainState))
 -> StateT
      MockChainState (WriterT MockChainBook m) (Either MockChainError a))
-> (MockChainState
    -> WriterT
         MockChainBook m (Either MockChainError a, MockChainState))
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError a)
forall a b. (a -> b) -> a -> b
$ WriterT MockChainBook m (Either MockChainError a, MockChainState)
-> MockChainState
-> WriterT
     MockChainBook m (Either MockChainError a, MockChainState)
forall a b. a -> b -> a
const (WriterT MockChainBook m (Either MockChainError a, MockChainState)
 -> MockChainState
 -> WriterT
      MockChainBook m (Either MockChainError a, MockChainState))
-> WriterT
     MockChainBook m (Either MockChainError a, MockChainState)
-> MockChainState
-> WriterT
     MockChainBook m (Either MockChainError a, MockChainState)
forall a b. (a -> b) -> a -> b
$ m ((Either MockChainError a, MockChainState), MockChainBook)
-> WriterT
     MockChainBook m (Either MockChainError a, MockChainState)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT m ((Either MockChainError a, MockChainState), MockChainBook)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  <|> :: forall a. MockChainT m a -> MockChainT m a -> MockChainT m a
(<|>) = (forall a. m a -> m a -> m a)
-> MockChainT m a -> MockChainT m a -> MockChainT m a
forall (m :: * -> *) x.
(forall a. m a -> m a -> m a)
-> MockChainT m x -> MockChainT m x -> MockChainT m x
combineMockChainT m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

-- | Combines two 'MockChainT' together
combineMockChainT :: (forall a. m a -> m a -> m a) -> MockChainT m x -> MockChainT m x -> MockChainT m x
combineMockChainT :: forall (m :: * -> *) x.
(forall a. m a -> m a -> m a)
-> MockChainT m x -> MockChainT m x -> MockChainT m x
combineMockChainT forall a. m a -> m a -> m a
f MockChainT m x
ma MockChainT m x
mb = ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> MockChainT m x
forall (m :: * -> *) a.
ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (ExceptT
   MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
 -> MockChainT m x)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> MockChainT m x
forall a b. (a -> b) -> a -> b
$
  StateT
  MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT
   MockChainState (WriterT MockChainBook m) (Either MockChainError x)
 -> ExceptT
      MockChainError (StateT MockChainState (WriterT MockChainBook m)) x)
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
forall a b. (a -> b) -> a -> b
$
    (MockChainState
 -> WriterT
      MockChainBook m (Either MockChainError x, MockChainState))
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError x)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((MockChainState
  -> WriterT
       MockChainBook m (Either MockChainError x, MockChainState))
 -> StateT
      MockChainState (WriterT MockChainBook m) (Either MockChainError x))
-> (MockChainState
    -> WriterT
         MockChainBook m (Either MockChainError x, MockChainState))
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError x)
forall a b. (a -> b) -> a -> b
$ \MockChainState
s ->
      let resA :: m ((Either MockChainError x, MockChainState), MockChainBook)
resA = WriterT MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT MockChainBook m (Either MockChainError x, MockChainState)
 -> m ((Either MockChainError x, MockChainState), MockChainBook))
-> WriterT
     MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> MockChainState
-> WriterT
     MockChainBook m (Either MockChainError x, MockChainState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (MockChainT m x
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain MockChainT m x
ma)) MockChainState
s
          resB :: m ((Either MockChainError x, MockChainState), MockChainBook)
resB = WriterT MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT MockChainBook m (Either MockChainError x, MockChainState)
 -> m ((Either MockChainError x, MockChainState), MockChainBook))
-> WriterT
     MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> MockChainState
-> WriterT
     MockChainBook m (Either MockChainError x, MockChainState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (MockChainT m x
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain MockChainT m x
mb)) MockChainState
s
       in m ((Either MockChainError x, MockChainState), MockChainBook)
-> WriterT
     MockChainBook m (Either MockChainError x, MockChainState)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m ((Either MockChainError x, MockChainState), MockChainBook)
 -> WriterT
      MockChainBook m (Either MockChainError x, MockChainState))
-> m ((Either MockChainError x, MockChainState), MockChainBook)
-> WriterT
     MockChainBook m (Either MockChainError x, MockChainState)
forall a b. (a -> b) -> a -> b
$ m ((Either MockChainError x, MockChainState), MockChainBook)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall a. m a -> m a -> m a
f m ((Either MockChainError x, MockChainState), MockChainBook)
resA m ((Either MockChainError x, MockChainState), MockChainBook)
resB

-- * 'MockChain' return types

-- | The returned type when running a 'MockChainT'. This is both a reorganizing
-- and filtering of the natural returned type @((Either MockChainError a,
-- MockChainState), MockChainBook)@, which is much easier to query.
data MockChainReturn a where
  MockChainReturn ::
    { -- | The value returned by the computation, or an error
      forall a. MockChainReturn a -> Either MockChainError a
mcrValue :: Either MockChainError a,
      -- | The outputs at the end of the run
      forall a. MockChainReturn a -> Map TxOutRef (TxSkelOut, Bool)
mcrOutputs :: Map Api.TxOutRef (TxSkelOut, Bool),
      -- | The 'UtxoState' at the end of the run
      forall a. MockChainReturn a -> UtxoState
mcrUtxoState :: UtxoState,
      -- | The final journal emitted during the run
      forall a. MockChainReturn a -> [MockChainLogEntry]
mcrJournal :: [MockChainLogEntry],
      -- | The map of aliases defined during the run
      forall a. MockChainReturn a -> Map BuiltinByteString String
mcrAliases :: Map Api.BuiltinByteString String
    } ->
    MockChainReturn a
  deriving ((forall a b. (a -> b) -> MockChainReturn a -> MockChainReturn b)
-> (forall a b. a -> MockChainReturn b -> MockChainReturn a)
-> Functor MockChainReturn
forall a b. a -> MockChainReturn b -> MockChainReturn a
forall a b. (a -> b) -> MockChainReturn a -> MockChainReturn b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> MockChainReturn a -> MockChainReturn b
fmap :: forall a b. (a -> b) -> MockChainReturn a -> MockChainReturn b
$c<$ :: forall a b. a -> MockChainReturn b -> MockChainReturn a
<$ :: forall a b. a -> MockChainReturn b -> MockChainReturn a
Functor)

-- | Raw return type of running a 'MockChainT'
type RawMockChainReturn a = ((Either MockChainError a, MockChainState), MockChainBook)

-- | Building a 'MockChainReturn' from a 'RawMockChainReturn'
unRawMockChainReturn :: RawMockChainReturn a -> MockChainReturn a
unRawMockChainReturn :: forall a. RawMockChainReturn a -> MockChainReturn a
unRawMockChainReturn ((Either MockChainError a
val, MockChainState
st), MockChainBook [MockChainLogEntry]
journal Map BuiltinByteString String
aliases) = Either MockChainError a
-> Map TxOutRef (TxSkelOut, Bool)
-> UtxoState
-> [MockChainLogEntry]
-> Map BuiltinByteString String
-> MockChainReturn a
forall a.
Either MockChainError a
-> Map TxOutRef (TxSkelOut, Bool)
-> UtxoState
-> [MockChainLogEntry]
-> Map BuiltinByteString String
-> MockChainReturn a
MockChainReturn Either MockChainError a
val (MockChainState -> Map TxOutRef (TxSkelOut, Bool)
mcstOutputs MockChainState
st) (MockChainState -> UtxoState
mcstToUtxoState MockChainState
st) [MockChainLogEntry]
journal Map BuiltinByteString String
aliases

-- * 'MockChain' configurations

-- | Configuration to run a 'MockChainT'
data MockChainConf a b where
  MockChainConf ::
    { -- | The initial state from which to run the 'MockChainT'
      forall a b. MockChainConf a b -> MockChainState
mccInitialState :: MockChainState,
      -- | The initial payments to issue in the run
      forall a b. MockChainConf a b -> InitialDistribution
mccInitialDistribution :: InitialDistribution,
      -- | The function to apply on the result of the run
      forall a b. MockChainConf a b -> RawMockChainReturn a -> b
mccFunOnResult :: RawMockChainReturn a -> b
    } ->
    MockChainConf a b

-- | A configuration with a default initial state, a given distribution,
-- returning a 'MockChainReturn'
initDistConf :: InitialDistribution -> MockChainConf a (MockChainReturn a)
initDistConf :: forall a.
InitialDistribution -> MockChainConf a (MockChainReturn a)
initDistConf InitialDistribution
i0 = MockChainState
-> InitialDistribution
-> (RawMockChainReturn a -> MockChainReturn a)
-> MockChainConf a (MockChainReturn a)
forall a b.
MockChainState
-> InitialDistribution
-> (RawMockChainReturn a -> b)
-> MockChainConf a b
MockChainConf MockChainState
forall a. Default a => a
def InitialDistribution
i0 RawMockChainReturn a -> MockChainReturn a
forall a. RawMockChainReturn a -> MockChainReturn a
unRawMockChainReturn

-- | A configuration with a given initial 'MockChainState', a default initial
-- distribution, returning the final 'MockChainState'
mockChainStateConf :: MockChainState -> MockChainConf a MockChainState
mockChainStateConf :: forall a. MockChainState -> MockChainConf a MockChainState
mockChainStateConf MockChainState
s0 = MockChainState
-> InitialDistribution
-> (RawMockChainReturn a -> MockChainState)
-> MockChainConf a MockChainState
forall a b.
MockChainState
-> InitialDistribution
-> (RawMockChainReturn a -> b)
-> MockChainConf a b
MockChainConf MockChainState
s0 InitialDistribution
forall a. Default a => a
def ((Either MockChainError a, MockChainState) -> MockChainState
forall a b. (a, b) -> b
snd ((Either MockChainError a, MockChainState) -> MockChainState)
-> (RawMockChainReturn a
    -> (Either MockChainError a, MockChainState))
-> RawMockChainReturn a
-> MockChainState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawMockChainReturn a -> (Either MockChainError a, MockChainState)
forall a b. (a, b) -> a
fst)

-- * 'MockChain' runs

-- We give the possibility to run a 'MockChain' or a 'MockChainT' from an
-- arbitrary 'MockChainConf', and instance for configuration with a given
-- 'InitialDistribution', which is the most used in our tests. All other
-- configuration can freely be built and used for runs.

-- | Runs a 'MockChainT' using a certain configuration
runMockChainTFromConf :: (Monad m) => MockChainConf a b -> MockChainT m a -> m b
runMockChainTFromConf :: forall (m :: * -> *) a b.
Monad m =>
MockChainConf a b -> MockChainT m a -> m b
runMockChainTFromConf MockChainConf {MockChainState
InitialDistribution
RawMockChainReturn a -> b
mccInitialState :: forall a b. MockChainConf a b -> MockChainState
mccInitialDistribution :: forall a b. MockChainConf a b -> InitialDistribution
mccFunOnResult :: forall a b. MockChainConf a b -> RawMockChainReturn a -> b
mccInitialState :: MockChainState
mccInitialDistribution :: InitialDistribution
mccFunOnResult :: RawMockChainReturn a -> b
..} =
  (RawMockChainReturn a -> b) -> m (RawMockChainReturn a) -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RawMockChainReturn a -> b
mccFunOnResult
    (m (RawMockChainReturn a) -> m b)
-> (MockChainT m a -> m (RawMockChainReturn a))
-> MockChainT m a
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT MockChainBook m (Either MockChainError a, MockChainState)
-> m (RawMockChainReturn a)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
    (WriterT MockChainBook m (Either MockChainError a, MockChainState)
 -> m (RawMockChainReturn a))
-> (MockChainT m a
    -> WriterT
         MockChainBook m (Either MockChainError a, MockChainState))
-> MockChainT m a
-> m (RawMockChainReturn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   MockChainState (WriterT MockChainBook m) (Either MockChainError a)
 -> MockChainState
 -> WriterT
      MockChainBook m (Either MockChainError a, MockChainState))
-> MockChainState
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> WriterT
     MockChainBook m (Either MockChainError a, MockChainState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> MockChainState
-> WriterT
     MockChainBook m (Either MockChainError a, MockChainState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT MockChainState
mccInitialState
    (StateT
   MockChainState (WriterT MockChainBook m) (Either MockChainError a)
 -> WriterT
      MockChainBook m (Either MockChainError a, MockChainState))
-> (MockChainT m a
    -> StateT
         MockChainState (WriterT MockChainBook m) (Either MockChainError a))
-> MockChainT m a
-> WriterT
     MockChainBook m (Either MockChainError a, MockChainState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
    (ExceptT
   MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
 -> StateT
      MockChainState (WriterT MockChainBook m) (Either MockChainError a))
-> (MockChainT m a
    -> ExceptT
         MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> MockChainT m a
-> StateT
     MockChainState (WriterT MockChainBook m) (Either MockChainError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainT m a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain
    (MockChainT m a
 -> ExceptT
      MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> (MockChainT m a -> MockChainT m a)
-> MockChainT m a
-> ExceptT
     MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxSkelOut] -> MockChainT m [TxOutRef]
forall (m :: * -> *).
MonadBlockChain m =>
[TxSkelOut] -> m [TxOutRef]
forceOutputs (InitialDistribution -> [TxSkelOut]
unInitialDistribution InitialDistribution
mccInitialDistribution) MockChainT m [TxOutRef] -> MockChainT m a -> MockChainT m a
forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)

-- | Runs a 'MockChain' using a certain configuration
runMockChainFromConf :: MockChainConf a b -> MockChain a -> b
runMockChainFromConf :: forall a b. MockChainConf a b -> MockChain a -> b
runMockChainFromConf MockChainConf a b
conf = Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b)
-> (MockChain a -> Identity b) -> MockChain a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainConf a b -> MockChain a -> Identity b
forall (m :: * -> *) a b.
Monad m =>
MockChainConf a b -> MockChainT m a -> m b
runMockChainTFromConf MockChainConf a b
conf

-- | Runs a 'MockChainT' from an initial 'InitialDistribution'
runMockChainTFromInitDist :: (Monad m) => InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
runMockChainTFromInitDist :: forall (m :: * -> *) a.
Monad m =>
InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
runMockChainTFromInitDist InitialDistribution
i0 = MockChainConf a (MockChainReturn a)
-> MockChainT m a -> m (MockChainReturn a)
forall (m :: * -> *) a b.
Monad m =>
MockChainConf a b -> MockChainT m a -> m b
runMockChainTFromConf (InitialDistribution -> MockChainConf a (MockChainReturn a)
forall a.
InitialDistribution -> MockChainConf a (MockChainReturn a)
initDistConf InitialDistribution
i0)

-- | See 'runMockChainTFromInitDist'
runMockChainFromInitDist :: InitialDistribution -> MockChain a -> MockChainReturn a
runMockChainFromInitDist :: forall a. InitialDistribution -> MockChain a -> MockChainReturn a
runMockChainFromInitDist InitialDistribution
i0 = Identity (MockChainReturn a) -> MockChainReturn a
forall a. Identity a -> a
runIdentity (Identity (MockChainReturn a) -> MockChainReturn a)
-> (MockChain a -> Identity (MockChainReturn a))
-> MockChain a
-> MockChainReturn a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitialDistribution -> MockChain a -> Identity (MockChainReturn a)
forall (m :: * -> *) a.
Monad m =>
InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
runMockChainTFromInitDist InitialDistribution
i0

-- | Uses 'runMockChainTFromInitDist' with a default 'InitialDistribution'
runMockChainT :: (Monad m) => MockChainT m a -> m (MockChainReturn a)
runMockChainT :: forall (m :: * -> *) a.
Monad m =>
MockChainT m a -> m (MockChainReturn a)
runMockChainT = InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
forall (m :: * -> *) a.
Monad m =>
InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
runMockChainTFromInitDist InitialDistribution
forall a. Default a => a
def

-- | Uses 'runMockChainFromInitDist' with a default 'InitialDistribution'
runMockChain :: MockChain a -> MockChainReturn a
runMockChain :: forall a. MockChain a -> MockChainReturn a
runMockChain = InitialDistribution -> MockChain a -> MockChainReturn a
forall a. InitialDistribution -> MockChain a -> MockChainReturn a
runMockChainFromInitDist InitialDistribution
forall a. Default a => a
def

-- * Direct Interpretation of Operations

instance (Monad m) => MonadBlockChainBalancing (MockChainT m) where
  getParams :: MockChainT m Params
getParams = (MockChainState -> Params) -> MockChainT m Params
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainState -> Params
mcstParams
  txSkelOutByRef :: TxOutRef -> MockChainT m TxSkelOut
txSkelOutByRef TxOutRef
oRef = do
    Maybe (TxSkelOut, Bool)
res <- (MockChainState -> Maybe (TxSkelOut, Bool))
-> MockChainT m (Maybe (TxSkelOut, Bool))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MockChainState -> Maybe (TxSkelOut, Bool))
 -> MockChainT m (Maybe (TxSkelOut, Bool)))
-> (MockChainState -> Maybe (TxSkelOut, Bool))
-> MockChainT m (Maybe (TxSkelOut, Bool))
forall a b. (a -> b) -> a -> b
$ TxOutRef
-> Map TxOutRef (TxSkelOut, Bool) -> Maybe (TxSkelOut, Bool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
oRef (Map TxOutRef (TxSkelOut, Bool) -> Maybe (TxSkelOut, Bool))
-> (MockChainState -> Map TxOutRef (TxSkelOut, Bool))
-> MockChainState
-> Maybe (TxSkelOut, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState -> Map TxOutRef (TxSkelOut, Bool)
mcstOutputs
    case Maybe (TxSkelOut, Bool)
res of
      Just (TxSkelOut
txSkelOut, Bool
True) -> TxSkelOut -> MockChainT m TxSkelOut
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOut
txSkelOut
      Maybe (TxSkelOut, Bool)
_ -> MockChainError -> MockChainT m TxSkelOut
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m TxSkelOut)
-> MockChainError -> MockChainT m TxSkelOut
forall a b. (a -> b) -> a -> b
$ TxOutRef -> MockChainError
MCEUnknownOutRef TxOutRef
oRef
  utxosAt :: forall a. ToAddress a => a -> MockChainT m Utxos
utxosAt (a -> Address
forall a. ToAddress a => a -> Address
Script.toAddress -> Address
addr) = ((TxOutRef, TxSkelOut) -> Bool) -> Utxos -> Utxos
forall a. (a -> Bool) -> [a] -> [a]
filter ((Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
==) (Address -> Bool)
-> ((TxOutRef, TxSkelOut) -> Address)
-> (TxOutRef, TxSkelOut)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Getter NoIx TxSkelOut Address -> TxSkelOut -> Address
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx TxSkelOut Address
txSkelOutAddressG (TxSkelOut -> Address)
-> ((TxOutRef, TxSkelOut) -> TxSkelOut)
-> (TxOutRef, TxSkelOut)
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxSkelOut) -> TxSkelOut
forall a b. (a, b) -> b
snd) (Utxos -> Utxos) -> MockChainT m Utxos -> MockChainT m Utxos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockChainT m Utxos
forall (m :: * -> *). MonadBlockChainWithoutValidation m => m Utxos
allUtxos
  logEvent :: MockChainLogEntry -> MockChainT m ()
logEvent MockChainLogEntry
l = MockChainBook -> MockChainT m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (MockChainBook -> MockChainT m ())
-> MockChainBook -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ [MockChainLogEntry]
-> Map BuiltinByteString String -> MockChainBook
MockChainBook [MockChainLogEntry
l] Map BuiltinByteString String
forall k a. Map k a
Map.empty

instance (Monad m) => MonadBlockChainWithoutValidation (MockChainT m) where
  allUtxos :: MockChainT m Utxos
allUtxos =
    (MockChainState -> Utxos) -> MockChainT m Utxos
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MockChainState -> Utxos) -> MockChainT m Utxos)
-> (MockChainState -> Utxos) -> MockChainT m Utxos
forall a b. (a -> b) -> a -> b
$
      ((TxOutRef, (TxSkelOut, Bool)) -> Maybe (TxOutRef, TxSkelOut))
-> [(TxOutRef, (TxSkelOut, Bool))] -> Utxos
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        (\(TxOutRef
oRef, (TxSkelOut
txSkelOut, Bool
isAvailable)) -> if Bool
isAvailable then (TxOutRef, TxSkelOut) -> Maybe (TxOutRef, TxSkelOut)
forall a. a -> Maybe a
Just (TxOutRef
oRef, TxSkelOut
txSkelOut) else Maybe (TxOutRef, TxSkelOut)
forall a. Maybe a
Nothing)
        ([(TxOutRef, (TxSkelOut, Bool))] -> Utxos)
-> (MockChainState -> [(TxOutRef, (TxSkelOut, Bool))])
-> MockChainState
-> Utxos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef (TxSkelOut, Bool) -> [(TxOutRef, (TxSkelOut, Bool))]
forall k a. Map k a -> [(k, a)]
Map.toList
        (Map TxOutRef (TxSkelOut, Bool) -> [(TxOutRef, (TxSkelOut, Bool))])
-> (MockChainState -> Map TxOutRef (TxSkelOut, Bool))
-> MockChainState
-> [(TxOutRef, (TxSkelOut, Bool))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState -> Map TxOutRef (TxSkelOut, Bool)
mcstOutputs
  setParams :: Params -> MockChainT m ()
setParams Params
params = do
    (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
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) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
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 (Params -> EmulatedLedgerState -> EmulatedLedgerState
Emulator.updateStateParams Params
params)
  waitNSlots :: forall i. Integral i => i -> MockChainT m Slot
waitNSlots i
n = do
    Slot
cs <- (MockChainState -> Slot) -> MockChainT m Slot
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (EmulatedLedgerState -> Slot
forall a. Num a => EmulatedLedgerState -> a
Emulator.getSlot (EmulatedLedgerState -> Slot)
-> (MockChainState -> EmulatedLedgerState)
-> MockChainState
-> Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState -> EmulatedLedgerState
mcstLedgerState)
    if
      | i
n i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
0 -> Slot -> MockChainT m Slot
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return Slot
cs
      | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
0 -> do
          let newSlot :: Slot
newSlot = Slot
cs Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ i -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n
          (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
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
$ Slot -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral Slot
newSlot)
          Slot -> MockChainT m Slot
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return Slot
newSlot
      | Bool
otherwise -> MockChainError -> MockChainT m Slot
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m Slot)
-> MockChainError -> MockChainT m Slot
forall a b. (a -> b) -> a -> b
$ Slot -> Slot -> MockChainError
MCEPastSlot Slot
cs (Slot
cs Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ i -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n)
  define :: forall a. ToHash a => String -> a -> MockChainT m a
define String
name a
hashable = MockChainBook -> MockChainT m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([MockChainLogEntry]
-> Map BuiltinByteString String -> MockChainBook
MockChainBook [] (BuiltinByteString -> String -> Map BuiltinByteString String
forall k a. k -> a -> Map k a
Map.singleton (a -> BuiltinByteString
forall a. ToHash a => a -> BuiltinByteString
toHash a
hashable) String
name)) MockChainT m () -> MockChainT m a -> MockChainT m a
forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> MockChainT m a
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
hashable
  setConstitutionScript :: forall s. ToVScript s => s -> MockChainT m ()
setConstitutionScript (s -> VScript
forall script. ToVScript script => script -> VScript
toVScript -> VScript
cScript) = do
    (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
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) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
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
  getConstitutionScript :: MockChainT m (Maybe VScript)
getConstitutionScript = (MockChainState -> Maybe VScript) -> MockChainT m (Maybe VScript)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens' MockChainState (Maybe VScript)
-> MockChainState -> Maybe VScript
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' MockChainState (Maybe VScript)
mcstConstitutionL)
  getCurrentReward :: forall c. ToCredential c => c -> MockChainT m (Maybe Lovelace)
getCurrentReward (c -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) = do
    Credential 'Staking
stakeCredential <- Credential -> MockChainT m (Credential 'Staking)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Credential -> m (Credential 'Staking)
toStakeCredential Credential
cred
    (MockChainState -> Maybe Lovelace) -> MockChainT m (Maybe Lovelace)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coin -> Lovelace
forall a b. Coercible a b => a -> b
coerce (Maybe Coin -> Maybe Lovelace)
-> (MockChainState -> Maybe Coin)
-> MockChainState
-> Maybe Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking -> EmulatedLedgerState -> Maybe Coin
Emulator.getReward Credential 'Staking
stakeCredential (EmulatedLedgerState -> Maybe Coin)
-> (MockChainState -> EmulatedLedgerState)
-> MockChainState
-> Maybe Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> MockChainState -> EmulatedLedgerState
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL)

-- | Most of the logic of the direct emulation happens here
instance (Monad m) => MonadBlockChain (MockChainT m) where
  validateTxSkel :: TxSkel -> MockChainT m CardanoTx
validateTxSkel TxSkel
txSkel | TxSkelOpts {Bool
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
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
..} <- TxSkel -> TxSkelOpts
txSkelOpts TxSkel
txSkel = do
    -- We log the submission of a new skeleton
    MockChainLogEntry -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> MockChainT m ())
-> MockChainLogEntry -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ TxSkel -> MockChainLogEntry
MCLogSubmittedTxSkel TxSkel
txSkel
    -- We retrieve the current parameters
    Params
oldParams <- MockChainT m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m 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
    Params -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Params -> m ()
setParams Params
newParams
    -- We ensure that the outputs have the required minimal amount of ada, when
    -- requested in the skeleton options
    TxSkel
txSkel <- TxSkel -> MockChainT m TxSkel
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m TxSkel
autoFillMinAda TxSkel
txSkel
    -- We retrieve the official constitution script and attach it to each
    -- proposal that requires it, if it's not empty
    TxSkel
txSkel <- TxSkel -> MockChainT m TxSkel
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
TxSkel -> m TxSkel
autoFillConstitution TxSkel
txSkel
    -- 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
    TxSkel
txSkel <- TxSkel -> MockChainT m TxSkel
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m TxSkel
autoFillReferenceScripts TxSkel
txSkel
    -- We attach the reward amount to withdrawals when applicable
    TxSkel
txSkel <- TxSkel -> MockChainT m TxSkel
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
TxSkel -> m TxSkel
autoFillWithdrawalAmounts TxSkel
txSkel
    -- We balance the skeleton when requested in the skeleton option, and get
    -- the associated fee, collateral inputs and return collateral user
    (TxSkel
txSkel, Integer
fee, Collaterals
mCollaterals) <- TxSkel -> MockChainT m (TxSkel, Integer, Collaterals)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (TxSkel, Integer, Collaterals)
balanceTxSkel TxSkel
txSkel
    -- We log the adjusted skeleton
    MockChainLogEntry -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> MockChainT m ())
-> MockChainLogEntry -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ TxSkel -> Integer -> Collaterals -> MockChainLogEntry
MCLogAdjustedTxSkel TxSkel
txSkel Integer
fee Collaterals
mCollaterals
    -- We generate the transaction asscoiated with the skeleton, and apply on it
    -- the modifications from the skeleton options
    CardanoTx
cardanoTx <- Tx ConwayEra -> CardanoTx
Ledger.CardanoEmulatorEraTx (Tx ConwayEra -> CardanoTx)
-> (Tx ConwayEra -> Tx ConwayEra) -> Tx ConwayEra -> CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx ConwayEra -> Tx ConwayEra
txSkelOptModTx (Tx ConwayEra -> CardanoTx)
-> MockChainT m (Tx ConwayEra) -> MockChainT m CardanoTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkel -> Integer -> Collaterals -> MockChainT m (Tx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> Integer -> Collaterals -> m (Tx ConwayEra)
txSkelToCardanoTx TxSkel
txSkel Integer
fee Collaterals
mCollaterals
    -- To run transaction validation we need a minimal ledger state
    EmulatedLedgerState
eLedgerState <- (MockChainState -> EmulatedLedgerState)
-> MockChainT m EmulatedLedgerState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m 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.
    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 -> MockChainT m ()
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m ())
-> MockChainError -> MockChainT m ()
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, Peer
retColUser) <- Collaterals
mCollaterals -> do
        -- We update the emulated ledger state
        (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
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 -> MockChainT m ()) -> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ CollateralIns
colInputs ((TxOutRef -> MockChainT m ()) -> MockChainT m ())
-> (TxOutRef -> MockChainT m ()) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> (TxOutRef -> MockChainState -> MockChainState)
-> TxOutRef
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> MockChainState -> MockChainState
removeOutput
        -- We add the returned collateral to our outputs (in practice this map
        -- either contains no element, or a single one)
        [(TxIn, TxOut)]
-> ((TxIn, TxOut) -> MockChainT m ()) -> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (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) (((TxIn, TxOut) -> MockChainT m ()) -> MockChainT m ())
-> ((TxIn, TxOut) -> MockChainT m ()) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ \(TxIn
txIn, TxOut
txOut) ->
          (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$
            TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
addOutput
              (TxIn -> TxOutRef
Ledger.fromCardanoTxIn TxIn
txIn)
              (Peer
retColUser Peer -> Payable '[ 'IsValue] -> TxSkelOut
forall owner (els :: [PayableKind]).
IsTxSkelOutAllowedOwner owner =>
owner -> Payable els -> TxSkelOut
`receives` Value -> Payable '[ 'IsValue]
forall a1. ToValue a1 => a1 -> Payable '[ 'IsValue]
Value (TxOut -> Value
Api.txOutValue (TxOut -> Value) -> (TxOut -> TxOut) -> TxOut -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx ConwayEra -> TxOut
forall era. TxOut CtxTx era -> TxOut
Ledger.fromCardanoTxOutToPV2TxInfoTxOut (TxOut CtxTx ConwayEra -> TxOut)
-> (TxOut -> TxOut CtxTx ConwayEra) -> TxOut -> TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> TxOut CtxTx ConwayEra
Ledger.getTxOut (TxOut -> Value) -> TxOut -> Value
forall a b. (a -> b) -> a -> b
$ TxOut
txOut))
        -- We throw a mockchain error
        MockChainError -> MockChainT m ()
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m ())
-> MockChainError -> MockChainT m ()
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) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
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 add the news utxos to the state
        Utxos
-> ((TxOutRef, TxSkelOut) -> MockChainT m ()) -> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([TxOutRef] -> [TxSkelOut] -> Utxos
forall a b. [a] -> [b] -> [(a, b)]
zip [TxOutRef]
utxos (TxSkel -> [TxSkelOut]
txSkelOuts TxSkel
txSkel)) (((TxOutRef, TxSkelOut) -> MockChainT m ()) -> MockChainT m ())
-> ((TxOutRef, TxSkelOut) -> MockChainT m ()) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> ((TxOutRef, TxSkelOut) -> MockChainState -> MockChainState)
-> (TxOutRef, TxSkelOut)
-> MockChainT m ()
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) -> MockChainT m ())
-> MockChainT m ()
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
txSkel) (((TxOutRef, TxSkelRedeemer) -> MockChainT m ())
 -> MockChainT m ())
-> ((TxOutRef, TxSkelRedeemer) -> MockChainT m ())
-> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> ((TxOutRef, TxSkelRedeemer) -> MockChainState -> MockChainState)
-> (TxOutRef, TxSkelRedeemer)
-> MockChainT m ()
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
      -- 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 {})
        | Collaterals
Nothing <- Collaterals
mCollaterals ->
            String -> MockChainT m ()
forall a. String -> MockChainT m 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 -> MockChainT m () -> MockChainT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
txSkelOptAutoSlotIncrease (MockChainT m () -> MockChainT m ())
-> MockChainT m () -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
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
    Params -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Params -> m ()
setParams Params
oldParams
    -- We log the validated transaction
    MockChainLogEntry -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> MockChainT m ())
-> MockChainLogEntry -> MockChainT m ()
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
    CardanoTx -> MockChainT m CardanoTx
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return CardanoTx
cardanoTx

  forceOutputs :: [TxSkelOut] -> MockChainT m [TxOutRef]
forceOutputs [TxSkelOut]
outputs = do
    -- We retrieve the protocol parameters
    Params
params <- MockChainT m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m 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 -> MockChainT m TxSkelOut)
-> [TxSkelOut] -> MockChainT m [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 -> MockChainT m TxSkelOut
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m TxSkelOut
toTxSkelOutWithMinAda [TxSkelOut]
outputs
    -- We transform these outputs to Cardano outputs
    [TxOut CtxTx ConwayEra]
outputs' <- (TxSkelOut -> MockChainT m (TxOut CtxTx ConwayEra))
-> [TxSkelOut] -> MockChainT m [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 -> MockChainT m (TxOut CtxTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m (TxOut CtxTx ConwayEra)
toCardanoTxOut [TxSkelOut]
outputsMinAda
    -- We create our transaction body, which only consists of the dummy input
    -- and the outputs to force. This create might result in an error.
    let transactionBody :: Either ToCardanoError (TxBody ConwayEra)
transactionBody =
          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 retrieve the forcefully validated transaction associated with the
    -- body, handling errors in the process.
    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)
-> MockChainT m (TxBody ConwayEra) -> MockChainT m CardanoTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ToCardanoError -> MockChainT m (TxBody ConwayEra))
-> (TxBody ConwayEra -> MockChainT m (TxBody ConwayEra))
-> Either ToCardanoError (TxBody ConwayEra)
-> MockChainT m (TxBody ConwayEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MockChainError -> MockChainT m (TxBody ConwayEra)
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m (TxBody ConwayEra))
-> (ToCardanoError -> MockChainError)
-> ToCardanoError
-> MockChainT m (TxBody ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ToCardanoError -> MockChainError
MCEToCardanoError String
"forceOutputs :") TxBody ConwayEra -> MockChainT m (TxBody ConwayEra)
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either ToCardanoError (TxBody ConwayEra)
transactionBody
    -- 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) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
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) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
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
    ((TxOutRef, TxSkelOut) -> TxOutRef) -> Utxos -> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOutRef, TxSkelOut) -> TxOutRef
forall a b. (a, b) -> a
fst (Utxos -> [TxOutRef])
-> MockChainT m Utxos -> MockChainT m [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoTx -> MockChainT m Utxos
forall (m :: * -> *).
MonadBlockChainBalancing m =>
CardanoTx -> m Utxos
utxosFromCardanoTx CardanoTx
cardanoTx