-- | 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.Node.Emulator.Internal.Node qualified as Emulator
import Control.Applicative
import Control.Arrow
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.AutoReferenceScripts
import Cooked.MockChain.Balancing
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx
import Cooked.MockChain.MinAda
import Cooked.MockChain.MockChainSt
import Cooked.MockChain.UtxoState
import Cooked.Output
import Cooked.Pretty.Hashable
import Cooked.Skeleton
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 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 'MockChainSt'
--
-- - 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 = 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
  }

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.
newtype MockChainT m a = MockChainT
  {forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
unMockChain :: (StateT MockChainSt (ExceptT MockChainError (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 MockChainSt,
      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 StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
x >>= :: forall a b.
MockChainT m a -> (a -> MockChainT m b) -> MockChainT m b
>>= a -> MockChainT m b
f = StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b
-> MockChainT m b
forall (m :: * -> *) a.
StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (StateT
   MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b
 -> MockChainT m b)
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b
-> MockChainT m b
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
x StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> (a
    -> StateT
         MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b)
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b
forall a b.
StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> (a
    -> StateT
         MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b)
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MockChainT m b
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
unMockChain (MockChainT m b
 -> StateT
      MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) b)
-> (a -> MockChainT m b)
-> a
-> StateT
     MockChainSt (ExceptT MockChainError (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 = StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainT m a
forall (m :: * -> *) a.
StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (StateT
   MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
 -> MockChainT m a)
-> (m a
    -> StateT
         MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a)
-> m a
-> MockChainT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT MockChainError (WriterT MockChainBook m) a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
forall (m :: * -> *) a. Monad m => m a -> StateT MockChainSt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT MockChainError (WriterT MockChainBook m) a
 -> StateT
      MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a)
-> (m a -> ExceptT MockChainError (WriterT MockChainBook m) a)
-> m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT MockChainBook m a
-> ExceptT MockChainError (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 (WriterT MockChainBook m a
 -> ExceptT MockChainError (WriterT MockChainBook m) a)
-> (m a -> WriterT MockChainBook m a)
-> m a
-> ExceptT MockChainError (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 = StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainT m a
forall (m :: * -> *) a.
StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (StateT
   MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
 -> MockChainT m a)
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainT m a
forall a b. (a -> b) -> a -> b
$ (MockChainSt
 -> ExceptT
      MockChainError (WriterT MockChainBook m) (a, MockChainSt))
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((MockChainSt
  -> ExceptT
       MockChainError (WriterT MockChainBook m) (a, MockChainSt))
 -> StateT
      MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a)
-> (MockChainSt
    -> ExceptT
         MockChainError (WriterT MockChainBook m) (a, MockChainSt))
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
forall a b. (a -> b) -> a -> b
$ ExceptT MockChainError (WriterT MockChainBook m) (a, MockChainSt)
-> MockChainSt
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
forall a b. a -> b -> a
const (ExceptT MockChainError (WriterT MockChainBook m) (a, MockChainSt)
 -> MockChainSt
 -> ExceptT
      MockChainError (WriterT MockChainBook m) (a, MockChainSt))
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
-> MockChainSt
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
forall a b. (a -> b) -> a -> b
$ WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
 -> ExceptT
      MockChainError (WriterT MockChainBook m) (a, MockChainSt))
-> WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
forall a b. (a -> b) -> a -> b
$ m (Either MockChainError (a, MockChainSt), MockChainBook)
-> WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT m (Either MockChainError (a, MockChainSt), 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 = StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
-> MockChainT m x
forall (m :: * -> *) a.
StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (StateT
   MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
 -> MockChainT m x)
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
-> MockChainT m x
forall a b. (a -> b) -> a -> b
$
  (MockChainSt
 -> ExceptT
      MockChainError (WriterT MockChainBook m) (x, MockChainSt))
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((MockChainSt
  -> ExceptT
       MockChainError (WriterT MockChainBook m) (x, MockChainSt))
 -> StateT
      MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x)
-> (MockChainSt
    -> ExceptT
         MockChainError (WriterT MockChainBook m) (x, MockChainSt))
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
forall a b. (a -> b) -> a -> b
$ \MockChainSt
s ->
    let resA :: m (Either MockChainError (x, MockChainSt), MockChainBook)
resA = WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
-> m (Either MockChainError (x, MockChainSt), MockChainBook)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
 -> m (Either MockChainError (x, MockChainSt), MockChainBook))
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
-> m (Either MockChainError (x, MockChainSt), MockChainBook)
forall a b. (a -> b) -> a -> b
$ ExceptT MockChainError (WriterT MockChainBook m) (x, MockChainSt)
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MockChainError (WriterT MockChainBook m) (x, MockChainSt)
 -> WriterT
      MockChainBook m (Either MockChainError (x, MockChainSt)))
-> ExceptT
     MockChainError (WriterT MockChainBook m) (x, MockChainSt)
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
-> MockChainSt
-> ExceptT
     MockChainError (WriterT MockChainBook m) (x, MockChainSt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MockChainT m x
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
unMockChain MockChainT m x
ma) MockChainSt
s
        resB :: m (Either MockChainError (x, MockChainSt), MockChainBook)
resB = WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
-> m (Either MockChainError (x, MockChainSt), MockChainBook)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
 -> m (Either MockChainError (x, MockChainSt), MockChainBook))
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
-> m (Either MockChainError (x, MockChainSt), MockChainBook)
forall a b. (a -> b) -> a -> b
$ ExceptT MockChainError (WriterT MockChainBook m) (x, MockChainSt)
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MockChainError (WriterT MockChainBook m) (x, MockChainSt)
 -> WriterT
      MockChainBook m (Either MockChainError (x, MockChainSt)))
-> ExceptT
     MockChainError (WriterT MockChainBook m) (x, MockChainSt)
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
-> MockChainSt
-> ExceptT
     MockChainError (WriterT MockChainBook m) (x, MockChainSt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MockChainT m x
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) x
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
unMockChain MockChainT m x
mb) MockChainSt
s
     in WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
-> ExceptT
     MockChainError (WriterT MockChainBook m) (x, MockChainSt)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
 -> ExceptT
      MockChainError (WriterT MockChainBook m) (x, MockChainSt))
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
-> ExceptT
     MockChainError (WriterT MockChainBook m) (x, MockChainSt)
forall a b. (a -> b) -> a -> b
$ m (Either MockChainError (x, MockChainSt), MockChainBook)
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (Either MockChainError (x, MockChainSt), MockChainBook)
 -> WriterT
      MockChainBook m (Either MockChainError (x, MockChainSt)))
-> m (Either MockChainError (x, MockChainSt), MockChainBook)
-> WriterT MockChainBook m (Either MockChainError (x, MockChainSt))
forall a b. (a -> b) -> a -> b
$ m (Either MockChainError (x, MockChainSt), MockChainBook)
-> m (Either MockChainError (x, MockChainSt), MockChainBook)
-> m (Either MockChainError (x, MockChainSt), MockChainBook)
forall a. m a -> m a -> m a
f m (Either MockChainError (x, MockChainSt), MockChainBook)
resA m (Either MockChainError (x, MockChainSt), MockChainBook)
resB

-- | A generic return type for a 'MockChain' run
type MockChainReturn a b = (Either MockChainError (a, b), MockChainBook)

-- | Transforms a 'MockChainT' into another one
mapMockChainT ::
  (m (MockChainReturn a MockChainSt) -> n (MockChainReturn b MockChainSt)) ->
  MockChainT m a ->
  MockChainT n b
mapMockChainT :: forall (m :: * -> *) a (n :: * -> *) b.
(m (MockChainReturn a MockChainSt)
 -> n (MockChainReturn b MockChainSt))
-> MockChainT m a -> MockChainT n b
mapMockChainT m (MockChainReturn a MockChainSt)
-> n (MockChainReturn b MockChainSt)
f = StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook n)) b
-> MockChainT n b
forall (m :: * -> *) a.
StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (StateT
   MockChainSt (ExceptT MockChainError (WriterT MockChainBook n)) b
 -> MockChainT n b)
-> (MockChainT m a
    -> StateT
         MockChainSt (ExceptT MockChainError (WriterT MockChainBook n)) b)
-> MockChainT m a
-> MockChainT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExceptT MockChainError (WriterT MockChainBook m) (a, MockChainSt)
 -> ExceptT
      MockChainError (WriterT MockChainBook n) (b, MockChainSt))
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook n)) b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
 -> WriterT
      MockChainBook n (Either MockChainError (b, MockChainSt)))
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
-> ExceptT
     MockChainError (WriterT MockChainBook n) (b, MockChainSt)
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT ((m (MockChainReturn a MockChainSt)
 -> n (MockChainReturn b MockChainSt))
-> WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
-> WriterT MockChainBook n (Either MockChainError (b, MockChainSt))
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT m (MockChainReturn a MockChainSt)
-> n (MockChainReturn b MockChainSt)
f)) (StateT
   MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
 -> StateT
      MockChainSt (ExceptT MockChainError (WriterT MockChainBook n)) b)
-> (MockChainT m a
    -> StateT
         MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a)
-> MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook n)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
unMockChain

-- | Runs a 'MockChainT' from a default 'MockChainSt'
runMockChainTRaw ::
  MockChainT m a ->
  m (MockChainReturn a MockChainSt)
runMockChainTRaw :: forall (m :: * -> *) a.
MockChainT m a -> m (MockChainReturn a MockChainSt)
runMockChainTRaw = WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
-> m (Either MockChainError (a, MockChainSt), MockChainBook)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
 -> m (Either MockChainError (a, MockChainSt), MockChainBook))
-> (MockChainT m a
    -> WriterT
         MockChainBook m (Either MockChainError (a, MockChainSt)))
-> MockChainT m a
-> m (Either MockChainError (a, MockChainSt), MockChainBook)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT MockChainError (WriterT MockChainBook m) (a, MockChainSt)
-> WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MockChainError (WriterT MockChainBook m) (a, MockChainSt)
 -> WriterT
      MockChainBook m (Either MockChainError (a, MockChainSt)))
-> (MockChainT m a
    -> ExceptT
         MockChainError (WriterT MockChainBook m) (a, MockChainSt))
-> MockChainT m a
-> WriterT MockChainBook m (Either MockChainError (a, MockChainSt))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
 -> MockChainSt
 -> ExceptT
      MockChainError (WriterT MockChainBook m) (a, MockChainSt))
-> MockChainSt
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
-> MockChainSt
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT MockChainSt
forall a. Default a => a
def (StateT
   MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
 -> ExceptT
      MockChainError (WriterT MockChainBook m) (a, MockChainSt))
-> (MockChainT m a
    -> StateT
         MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a)
-> MockChainT m a
-> ExceptT
     MockChainError (WriterT MockChainBook m) (a, MockChainSt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt (ExceptT MockChainError (WriterT MockChainBook m)) a
unMockChain

-- | Runs a 'MockChainT' from an initial 'MockChainSt' built from a given
-- 'InitialDistribution'. Returns a 'UtxoState'.
runMockChainTFrom ::
  (Monad m) =>
  InitialDistribution ->
  MockChainT m a ->
  m (MockChainReturn a UtxoState)
runMockChainTFrom :: forall (m :: * -> *) a.
Monad m =>
InitialDistribution
-> MockChainT m a -> m (MockChainReturn a UtxoState)
runMockChainTFrom InitialDistribution
i0 MockChainT m a
s =
  (Either MockChainError (a, MockChainSt)
 -> Either MockChainError (a, UtxoState))
-> (Either MockChainError (a, MockChainSt), MockChainBook)
-> (Either MockChainError (a, UtxoState), MockChainBook)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (((a, MockChainSt) -> (a, UtxoState))
-> Either MockChainError (a, MockChainSt)
-> Either MockChainError (a, UtxoState)
forall b c d. (b -> c) -> Either d b -> Either d c
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right ((MockChainSt -> UtxoState) -> (a, MockChainSt) -> (a, UtxoState)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second MockChainSt -> UtxoState
mcstToUtxoState))
    ((Either MockChainError (a, MockChainSt), MockChainBook)
 -> (Either MockChainError (a, UtxoState), MockChainBook))
-> m (Either MockChainError (a, MockChainSt), MockChainBook)
-> m (Either MockChainError (a, UtxoState), MockChainBook)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockChainT m a
-> m (Either MockChainError (a, MockChainSt), MockChainBook)
forall (m :: * -> *) a.
MockChainT m a -> m (MockChainReturn a MockChainSt)
runMockChainTRaw (InitialDistribution -> MockChainT m MockChainSt
forall (m :: * -> *).
MonadBlockChainBalancing m =>
InitialDistribution -> m MockChainSt
mockChainSt0From InitialDistribution
i0 MockChainT m MockChainSt
-> (MockChainSt -> MockChainT m ()) -> MockChainT m ()
forall a b.
MockChainT m a -> (a -> MockChainT m b) -> MockChainT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MockChainSt -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put 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
>> MockChainT m a
s)

-- | Executes a 'MockChainT' from the canonical initial state and environment.
runMockChainT :: (Monad m) => MockChainT m a -> m (MockChainReturn a UtxoState)
runMockChainT :: forall (m :: * -> *) a.
Monad m =>
MockChainT m a -> m (MockChainReturn a UtxoState)
runMockChainT = InitialDistribution
-> MockChainT m a -> m (MockChainReturn a UtxoState)
forall (m :: * -> *) a.
Monad m =>
InitialDistribution
-> MockChainT m a -> m (MockChainReturn a UtxoState)
runMockChainTFrom InitialDistribution
forall a. Default a => a
def

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

-- | See 'runMockChainT'
runMockChain :: MockChain a -> MockChainReturn a UtxoState
runMockChain :: forall a. MockChain a -> MockChainReturn a UtxoState
runMockChain = Identity (MockChainReturn a UtxoState)
-> MockChainReturn a UtxoState
forall a. Identity a -> a
runIdentity (Identity (MockChainReturn a UtxoState)
 -> MockChainReturn a UtxoState)
-> (MockChain a -> Identity (MockChainReturn a UtxoState))
-> MockChain a
-> MockChainReturn a UtxoState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChain a -> Identity (MockChainReturn a UtxoState)
forall (m :: * -> *) a.
Monad m =>
MockChainT m a -> m (MockChainReturn a UtxoState)
runMockChainT

-- * Direct Interpretation of Operations

instance (Monad m) => MonadBlockChainBalancing (MockChainT m) where
  getParams :: MockChainT m Params
getParams = (MockChainSt -> Params) -> MockChainT m Params
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainSt -> Params
mcstParams
  scriptFromHash :: ScriptHash -> MockChainT m (Maybe (Versioned Script))
scriptFromHash ScriptHash
sHash = (MockChainSt -> Maybe (Versioned Script))
-> MockChainT m (Maybe (Versioned Script))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MockChainSt -> Maybe (Versioned Script))
 -> MockChainT m (Maybe (Versioned Script)))
-> (MockChainSt -> Maybe (Versioned Script))
-> MockChainT m (Maybe (Versioned Script))
forall a b. (a -> b) -> a -> b
$ ScriptHash
-> Map ScriptHash (Versioned Script) -> Maybe (Versioned Script)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
sHash (Map ScriptHash (Versioned Script) -> Maybe (Versioned Script))
-> (MockChainSt -> Map ScriptHash (Versioned Script))
-> MockChainSt
-> Maybe (Versioned Script)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainSt -> Map ScriptHash (Versioned Script)
mcstScripts
  txOutByRef :: TxOutRef -> MockChainT m (Maybe TxOut)
txOutByRef TxOutRef
outref = (MockChainSt -> Maybe TxOut) -> MockChainT m (Maybe TxOut)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MockChainSt -> Maybe TxOut) -> MockChainT m (Maybe TxOut))
-> (MockChainSt -> Maybe TxOut) -> MockChainT m (Maybe TxOut)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Map TxOutRef TxOut -> Maybe TxOut
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
outref (Map TxOutRef TxOut -> Maybe TxOut)
-> (MockChainSt -> Map TxOutRef TxOut)
-> MockChainSt
-> Maybe TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex -> Map TxOutRef TxOut
getIndex (UtxoIndex -> Map TxOutRef TxOut)
-> (MockChainSt -> UtxoIndex) -> MockChainSt -> Map TxOutRef TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainSt -> UtxoIndex
mcstIndex
  datumFromHash :: DatumHash -> MockChainT m (Maybe Datum)
datumFromHash DatumHash
datumHash = (TxSkelOutDatum -> Maybe Datum
txSkelOutUntypedDatum (TxSkelOutDatum -> Maybe Datum)
-> (Map DatumHash (TxSkelOutDatum, Integer)
    -> Maybe TxSkelOutDatum)
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Maybe Datum
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< TxSkelOutDatum -> Maybe TxSkelOutDatum
forall a. a -> Maybe a
Just (TxSkelOutDatum -> Maybe TxSkelOutDatum)
-> ((TxSkelOutDatum, Integer) -> TxSkelOutDatum)
-> (TxSkelOutDatum, Integer)
-> Maybe TxSkelOutDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSkelOutDatum, Integer) -> TxSkelOutDatum
forall a b. (a, b) -> a
fst ((TxSkelOutDatum, Integer) -> Maybe TxSkelOutDatum)
-> (Map DatumHash (TxSkelOutDatum, Integer)
    -> Maybe (TxSkelOutDatum, Integer))
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Maybe TxSkelOutDatum
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DatumHash
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Maybe (TxSkelOutDatum, Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DatumHash
datumHash) (Map DatumHash (TxSkelOutDatum, Integer) -> Maybe Datum)
-> MockChainT m (Map DatumHash (TxSkelOutDatum, Integer))
-> MockChainT m (Maybe Datum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer))
-> MockChainT m (Map DatumHash (TxSkelOutDatum, Integer))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums
  utxosAt :: Address -> MockChainT m [(TxOutRef, TxOut)]
utxosAt Address
addr = ((TxOutRef, TxOut) -> Bool)
-> [(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
==) (Address -> Bool)
-> ((TxOutRef, TxOut) -> Address) -> (TxOutRef, TxOut) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Address
forall o.
(IsAbstractOutput o, ToCredential (OwnerType o)) =>
o -> Address
outputAddress (TxOut -> Address)
-> ((TxOutRef, TxOut) -> TxOut) -> (TxOutRef, TxOut) -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOut
forall a b. (a, b) -> b
snd) ([(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)])
-> MockChainT m [(TxOutRef, TxOut)]
-> MockChainT m [(TxOutRef, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockChainT m [(TxOutRef, TxOut)]
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m [(TxOutRef, TxOut)]
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 [(TxOutRef, TxOut)]
allUtxos = (MockChainSt -> [(TxOutRef, TxOut)])
-> MockChainT m [(TxOutRef, TxOut)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MockChainSt -> [(TxOutRef, TxOut)])
 -> MockChainT m [(TxOutRef, TxOut)])
-> (MockChainSt -> [(TxOutRef, TxOut)])
-> MockChainT m [(TxOutRef, TxOut)]
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef TxOut -> [(TxOutRef, TxOut)])
-> (MockChainSt -> Map TxOutRef TxOut)
-> MockChainSt
-> [(TxOutRef, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex -> Map TxOutRef TxOut
getIndex (UtxoIndex -> Map TxOutRef TxOut)
-> (MockChainSt -> UtxoIndex) -> MockChainSt -> Map TxOutRef TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainSt -> UtxoIndex
mcstIndex
  setParams :: Params -> MockChainT m ()
setParams Params
newParams = (MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MockChainSt
st -> MockChainSt
st {mcstParams = newParams})
  currentSlot :: MockChainT m Slot
currentSlot = (MockChainSt -> Slot) -> MockChainT m Slot
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainSt -> Slot
mcstCurrentSlot
  awaitSlot :: Slot -> MockChainT m Slot
awaitSlot Slot
slot = (MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\MockChainSt
st -> MockChainSt
st {mcstCurrentSlot = max slot (mcstCurrentSlot st)}) MockChainT m () -> MockChainT m Slot -> MockChainT m Slot
forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockChainT m Slot
forall (m :: * -> *). MonadBlockChainWithoutValidation m => m Slot
currentSlot
  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

-- | Most of the logic of the direct emulation happens here
instance (Monad m) => MonadBlockChain (MockChainT m) where
  validateTxSkel :: TxSkel -> MockChainT m CardanoTx
validateTxSkel TxSkel
skelUnbal | TxOpts {Bool
[RawModTx]
Maybe EmulatorParamsModification
AnchorResolution
CollateralUtxos
BalancingPolicy
BalancingUtxos
BalanceOutputPolicy
FeePolicy
txOptAutoSlotIncrease :: Bool
txOptUnsafeModTx :: [RawModTx]
txOptBalancingPolicy :: BalancingPolicy
txOptFeePolicy :: FeePolicy
txOptBalanceOutputPolicy :: BalanceOutputPolicy
txOptBalancingUtxos :: BalancingUtxos
txOptEmulatorParamsModification :: Maybe EmulatorParamsModification
txOptCollateralUtxos :: CollateralUtxos
txOptAnchorResolution :: AnchorResolution
txOptAutoSlotIncrease :: TxOpts -> Bool
txOptUnsafeModTx :: TxOpts -> [RawModTx]
txOptBalancingPolicy :: TxOpts -> BalancingPolicy
txOptFeePolicy :: TxOpts -> FeePolicy
txOptBalanceOutputPolicy :: TxOpts -> BalanceOutputPolicy
txOptBalancingUtxos :: TxOpts -> BalancingUtxos
txOptEmulatorParamsModification :: TxOpts -> Maybe EmulatorParamsModification
txOptCollateralUtxos :: TxOpts -> CollateralUtxos
txOptAnchorResolution :: TxOpts -> AnchorResolution
..} <- TxSkel -> TxOpts
txSkelOpts TxSkel
skelUnbal = do
    -- We retrieve the necessary logging data from the context
    Map TxOutRef TxOut
outputs <- (MockChainSt -> Map TxOutRef TxOut)
-> MockChainT m (Map TxOutRef TxOut)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (UtxoIndex -> Map TxOutRef TxOut
getIndex (UtxoIndex -> Map TxOutRef TxOut)
-> (MockChainSt -> UtxoIndex) -> MockChainSt -> Map TxOutRef TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainSt -> UtxoIndex
mcstIndex)
    Map DatumHash TxSkelOutDatum
datums <- (MockChainSt -> Map DatumHash TxSkelOutDatum)
-> MockChainT m (Map DatumHash TxSkelOutDatum)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((TxSkelOutDatum, Integer) -> TxSkelOutDatum)
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Map DatumHash TxSkelOutDatum
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TxSkelOutDatum, Integer) -> TxSkelOutDatum
forall a b. (a, b) -> a
fst (Map DatumHash (TxSkelOutDatum, Integer)
 -> Map DatumHash TxSkelOutDatum)
-> (MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer))
-> MockChainSt
-> Map DatumHash TxSkelOutDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums)
    -- 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
$ Map TxOutRef TxOut
-> Map DatumHash TxSkelOutDatum -> TxSkel -> MockChainLogEntry
MCLogSubmittedTxSkel Map TxOutRef TxOut
outputs Map DatumHash TxSkelOutDatum
datums TxSkel
skelUnbal
    -- 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 = Maybe EmulatorParamsModification -> Params -> Params
applyEmulatorParamsModification Maybe EmulatorParamsModification
txOptEmulatorParamsModification 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
minAdaSkelUnbal <- TxSkel -> MockChainT m TxSkel
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m TxSkel
toTxSkelWithMinAda TxSkel
skelUnbal
    -- 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
minAdaRefScriptsSkelUnbal <- TxSkel -> MockChainT m TxSkel
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m TxSkel
toTxSkelWithReferenceScripts TxSkel
minAdaSkelUnbal
    -- We balance the skeleton when requested in the skeleton option, and get
    -- the associated fee, collateral inputs and return collateral wallet
    (TxSkel
skel, Integer
fee, Maybe (Set TxOutRef, Wallet)
mCollaterals) <- TxSkel
-> MockChainT m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
balanceTxSkel TxSkel
minAdaRefScriptsSkelUnbal
    -- 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
$ Map TxOutRef TxOut
-> Map DatumHash TxSkelOutDatum
-> TxSkel
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> MockChainLogEntry
MCLogAdjustedTxSkel Map TxOutRef TxOut
outputs Map DatumHash TxSkelOutDatum
datums TxSkel
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
    -- We generate the transaction associated 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
. [RawModTx] -> Tx ConwayEra -> Tx ConwayEra
applyRawModOnBalancedTx [RawModTx]
txOptUnsafeModTx (Tx ConwayEra -> CardanoTx)
-> MockChainT m (Tx ConwayEra) -> MockChainT m CardanoTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkel
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> MockChainT m (Tx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel
-> Integer -> Maybe (Set TxOutRef, Wallet) -> m (Tx ConwayEra)
txSkelToCardanoTx TxSkel
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
    -- To run transaction validation we need a minimal ledger state
    EmulatedLedgerState
eLedgerState <- (MockChainSt -> EmulatedLedgerState)
-> MockChainT m EmulatedLedgerState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainSt -> EmulatedLedgerState
mcstToEmulatedLedgerState
    -- We finally run the emulated validation, and we only care about the
    -- validation result, as we update our own internal state
    let (Maybe EmulatedLedgerState
_, ValidationResult
mValidationResult) = Params
-> EmulatedLedgerState
-> CardanoTx
-> (Maybe EmulatedLedgerState, ValidationResult)
Emulator.validateCardanoTx Params
newParams EmulatedLedgerState
eLedgerState CardanoTx
cardanoTx
    -- We retrieve our current utxo index to perform modifications associated
    -- with the validated transaction.
    UtxoIndex
utxoIndex <- (MockChainSt -> UtxoIndex) -> MockChainT m UtxoIndex
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainSt -> UtxoIndex
mcstIndex
    -- We create a new utxo index with an error when validation failed
    let (UtxoIndex
newUtxoIndex, Maybe (ValidationPhase, ValidationError)
valError) = case ValidationResult
mValidationResult of
          -- In case of a phase 1 error, we give back the same index
          Ledger.FailPhase1 CardanoTx
_ ValidationError
err -> (UtxoIndex
utxoIndex, (ValidationPhase, ValidationError)
-> Maybe (ValidationPhase, ValidationError)
forall a. a -> Maybe a
Just (ValidationPhase
Ledger.Phase1, ValidationError
err))
          -- In case of a phase 2 error, we retrieve the collaterals (and yes,
          -- despite its name, 'insertCollateral' actually takes the collaterals
          -- away from the index)
          Ledger.FailPhase2 OnChainTx
_ ValidationError
err Value
_ -> (CardanoTx -> UtxoIndex -> UtxoIndex
Ledger.insertCollateral CardanoTx
cardanoTx UtxoIndex
utxoIndex, (ValidationPhase, ValidationError)
-> Maybe (ValidationPhase, ValidationError)
forall a. a -> Maybe a
Just (ValidationPhase
Ledger.Phase2, ValidationError
err))
          -- In case of success, we update the index with all inputs and outputs
          -- contained in the transaction
          Ledger.Success {} -> (CardanoTx -> UtxoIndex -> UtxoIndex
Ledger.insert CardanoTx
cardanoTx UtxoIndex
utxoIndex, Maybe (ValidationPhase, ValidationError)
forall a. Maybe a
Nothing)
    case Maybe (ValidationPhase, ValidationError)
valError of
      -- When validation failed for any reason, we throw an error. TODO: This
      -- behavior could be subject to change in the future.
      Just (ValidationPhase, ValidationError)
err -> MockChainError -> MockChainT m ()
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ((ValidationPhase -> ValidationError -> MockChainError)
-> (ValidationPhase, ValidationError) -> MockChainError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ValidationPhase -> ValidationError -> MockChainError
MCEValidationError (ValidationPhase, ValidationError)
err)
      -- Otherwise, we update known validators and datums.
      Maybe (ValidationPhase, ValidationError)
Nothing -> do
        -- We add the script in outputs
        [Versioned Validator]
-> (Versioned Validator -> MockChainT m ()) -> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((TxSkelOut -> Maybe (Versioned Validator))
-> [TxSkelOut] -> [Versioned Validator]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxSkelOut -> Maybe (Versioned Validator)
txSkelOutValidator (TxSkel -> [TxSkelOut]
txSkelOuts TxSkel
skel)) ((Versioned Validator -> MockChainT m ()) -> MockChainT m ())
-> (Versioned Validator -> MockChainT m ()) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainSt -> MockChainSt) -> MockChainT m ())
-> (Versioned Validator -> MockChainSt -> MockChainSt)
-> Versioned Validator
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioned Validator -> MockChainSt -> MockChainSt
forall s.
(ToScriptHash s, ToVersioned Script s) =>
s -> MockChainSt -> MockChainSt
addScript
        [Versioned Script]
-> (Versioned Script -> MockChainT m ()) -> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((TxSkelOut -> Maybe (Versioned Script))
-> [TxSkelOut] -> [Versioned Script]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxSkelOut -> Maybe (Versioned Script)
txSkelOutReferenceScript (TxSkel -> [TxSkelOut]
txSkelOuts TxSkel
skel)) ((Versioned Script -> MockChainT m ()) -> MockChainT m ())
-> (Versioned Script -> MockChainT m ()) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainSt -> MockChainSt) -> MockChainT m ())
-> (Versioned Script -> MockChainSt -> MockChainSt)
-> Versioned Script
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioned Script -> MockChainSt -> MockChainSt
forall s.
(ToScriptHash s, ToVersioned Script s) =>
s -> MockChainSt -> MockChainSt
addScript
        -- We remove the consumed datums
        TxSkel -> MockChainT m [DatumHash]
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m [DatumHash]
txSkelInputDataAsHashes TxSkel
skel MockChainT m [DatumHash]
-> ([DatumHash] -> MockChainT m ()) -> MockChainT m ()
forall a b.
MockChainT m a -> (a -> MockChainT m b) -> MockChainT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainSt -> MockChainSt) -> MockChainT m ())
-> ([DatumHash] -> MockChainSt -> MockChainSt)
-> [DatumHash]
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DatumHash] -> MockChainSt -> MockChainSt
removeDatums)
        -- We add the created datums
        ((MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainSt -> MockChainSt) -> MockChainT m ())
-> ([(DatumHash, TxSkelOutDatum)] -> MockChainSt -> MockChainSt)
-> [(DatumHash, TxSkelOutDatum)]
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(DatumHash, TxSkelOutDatum)] -> MockChainSt -> MockChainSt
addDatums) (TxSkel -> [(DatumHash, TxSkelOutDatum)]
txSkelDataInOutputs TxSkel
skel)
    -- Now that we have computed a new index, we can update it
    (MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\MockChainSt
st -> MockChainSt
st {mcstIndex = newUtxoIndex})
    -- 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
txOptAutoSlotIncrease (MockChainT m () -> MockChainT m ())
-> MockChainT m () -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\MockChainSt
st -> MockChainSt
st {mcstCurrentSlot = mcstCurrentSlot st + 1})
    -- 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 -> MockChainLogEntry
MCLogNewTx (TxId -> TxId
Ledger.fromCardanoTxId (TxId -> TxId) -> TxId -> TxId
forall a b. (a -> b) -> a -> b
$ CardanoTx -> TxId
Ledger.getCardanoTxId 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