-- | This module provides a direct (not 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.Skeleton
import Data.Default
import Data.Map.Strict qualified as Map
import Ledger.Index qualified as Ledger
import Ledger.Orphans ()
import Ledger.Tx qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger

-- * Direct Emulation

-- $mockchaindocstr
--
-- The MockChainT monad provides a direct emulator; that is, it gives us a
-- simple way to call validator scripts directly, without the need for all the
-- complexity the 'Contract' monad introduces.
--
-- Running a 'MockChain' produces a 'UtxoState', a simplified view on
-- 'Ledger.UtxoIndex', which we also keep in our state.

newtype MockChainT m a = MockChainT
  {forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
unMockChain :: (StateT MockChainSt (ExceptT MockChainError (WriterT [MockChainLogEntry] 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 [MockChainLogEntry])

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 [MockChainLogEntry] 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 [MockChainLogEntry] m))
  b
-> MockChainT m b
forall (m :: * -> *) a.
StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
-> MockChainT m a
MockChainT (StateT
   MockChainSt
   (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
   b
 -> MockChainT m b)
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     b
-> MockChainT m b
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
x StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
-> (a
    -> StateT
         MockChainSt
         (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
         b)
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     b
forall a b.
StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
-> (a
    -> StateT
         MockChainSt
         (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
         b)
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MockChainT m b
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     b
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
unMockChain (MockChainT m b
 -> StateT
      MockChainSt
      (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
      b)
-> (a -> MockChainT m b)
-> a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] 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 [MockChainLogEntry] m))
  a
-> MockChainT m a
forall (m :: * -> *) a.
StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
-> MockChainT m a
MockChainT (StateT
   MockChainSt
   (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
   a
 -> MockChainT m a)
-> (m a
    -> StateT
         MockChainSt
         (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
         a)
-> m a
-> MockChainT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT MockChainError (WriterT [MockChainLogEntry] m) a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] 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 [MockChainLogEntry] m) a
 -> StateT
      MockChainSt
      (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
      a)
-> (m a
    -> ExceptT MockChainError (WriterT [MockChainLogEntry] m) a)
-> m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [MockChainLogEntry] m a
-> ExceptT MockChainError (WriterT [MockChainLogEntry] 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 [MockChainLogEntry] m a
 -> ExceptT MockChainError (WriterT [MockChainLogEntry] m) a)
-> (m a -> WriterT [MockChainLogEntry] m a)
-> m a
-> ExceptT MockChainError (WriterT [MockChainLogEntry] m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> WriterT [MockChainLogEntry] m a
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [MockChainLogEntry] 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 [MockChainLogEntry] m))
  a
-> MockChainT m a
forall (m :: * -> *) a.
StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
-> MockChainT m a
MockChainT (StateT
   MockChainSt
   (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
   a
 -> MockChainT m a)
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
-> MockChainT m a
forall a b. (a -> b) -> a -> b
$ (MockChainSt
 -> ExceptT
      MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt))
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((MockChainSt
  -> ExceptT
       MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt))
 -> StateT
      MockChainSt
      (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
      a)
-> (MockChainSt
    -> ExceptT
         MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt))
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
forall a b. (a -> b) -> a -> b
$ ExceptT
  MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
-> MockChainSt
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
forall a b. a -> b -> a
const (ExceptT
   MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
 -> MockChainSt
 -> ExceptT
      MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt))
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
-> MockChainSt
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
forall a b. (a -> b) -> a -> b
$ WriterT
  [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (WriterT
   [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
 -> ExceptT
      MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt))
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
forall a b. (a -> b) -> a -> b
$ m (Either MockChainError (a, MockChainSt), [MockChainLogEntry])
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT m (Either MockChainError (a, MockChainSt), [MockChainLogEntry])
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
(<|>)

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 [MockChainLogEntry] m))
  x
-> MockChainT m x
forall (m :: * -> *) a.
StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
-> MockChainT m a
MockChainT (StateT
   MockChainSt
   (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
   x
 -> MockChainT m x)
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     x
-> MockChainT m x
forall a b. (a -> b) -> a -> b
$
  (MockChainSt
 -> ExceptT
      MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt))
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     x
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((MockChainSt
  -> ExceptT
       MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt))
 -> StateT
      MockChainSt
      (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
      x)
-> (MockChainSt
    -> ExceptT
         MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt))
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     x
forall a b. (a -> b) -> a -> b
$ \MockChainSt
s ->
    let resA :: m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
resA = WriterT
  [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
-> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
 -> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry]))
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
-> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
forall a b. (a -> b) -> a -> b
$ ExceptT
  MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
 -> WriterT
      [MockChainLogEntry] m (Either MockChainError (x, MockChainSt)))
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  x
-> MockChainSt
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MockChainT m x
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     x
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
unMockChain MockChainT m x
ma) MockChainSt
s
        resB :: m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
resB = WriterT
  [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
-> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
 -> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry]))
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
-> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
forall a b. (a -> b) -> a -> b
$ ExceptT
  MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
 -> WriterT
      [MockChainLogEntry] m (Either MockChainError (x, MockChainSt)))
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
forall a b. (a -> b) -> a -> b
$ StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  x
-> MockChainSt
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MockChainT m x
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     x
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
unMockChain MockChainT m x
mb) MockChainSt
s
     in WriterT
  [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (WriterT
   [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
 -> ExceptT
      MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt))
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (x, MockChainSt)
forall a b. (a -> b) -> a -> b
$ m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
 -> WriterT
      [MockChainLogEntry] m (Either MockChainError (x, MockChainSt)))
-> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (x, MockChainSt))
forall a b. (a -> b) -> a -> b
$ m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
-> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
-> m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
forall a. m a -> m a -> m a
f m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
resA m (Either MockChainError (x, MockChainSt), [MockChainLogEntry])
resB

type MockChainReturn a b = (Either MockChainError (a, b), [MockChainLogEntry])

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 [MockChainLogEntry] n))
  b
-> MockChainT n b
forall (m :: * -> *) a.
StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
-> MockChainT m a
MockChainT (StateT
   MockChainSt
   (ExceptT MockChainError (WriterT [MockChainLogEntry] n))
   b
 -> MockChainT n b)
-> (MockChainT m a
    -> StateT
         MockChainSt
         (ExceptT MockChainError (WriterT [MockChainLogEntry] n))
         b)
-> MockChainT m a
-> MockChainT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExceptT
   MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
 -> ExceptT
      MockChainError (WriterT [MockChainLogEntry] n) (b, MockChainSt))
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] n))
     b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((WriterT
   [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
 -> WriterT
      [MockChainLogEntry] n (Either MockChainError (b, MockChainSt)))
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] 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
     [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
-> WriterT
     [MockChainLogEntry] 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 [MockChainLogEntry] m))
   a
 -> StateT
      MockChainSt
      (ExceptT MockChainError (WriterT [MockChainLogEntry] n))
      b)
-> (MockChainT m a
    -> StateT
         MockChainSt
         (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
         a)
-> MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] n))
     b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
unMockChain

runMockChainTRaw ::
  MockChainT m a ->
  m (MockChainReturn a MockChainSt)
runMockChainTRaw :: forall (m :: * -> *) a.
MockChainT m a -> m (MockChainReturn a MockChainSt)
runMockChainTRaw = WriterT
  [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
-> m (Either MockChainError (a, MockChainSt), [MockChainLogEntry])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
 -> m (Either MockChainError (a, MockChainSt), [MockChainLogEntry]))
-> (MockChainT m a
    -> WriterT
         [MockChainLogEntry] m (Either MockChainError (a, MockChainSt)))
-> MockChainT m a
-> m (Either MockChainError (a, MockChainSt), [MockChainLogEntry])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
 -> WriterT
      [MockChainLogEntry] m (Either MockChainError (a, MockChainSt)))
-> (MockChainT m a
    -> ExceptT
         MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt))
-> MockChainT m a
-> WriterT
     [MockChainLogEntry] m (Either MockChainError (a, MockChainSt))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   MockChainSt
   (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
   a
 -> MockChainSt
 -> ExceptT
      MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt))
-> MockChainSt
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  MockChainSt
  (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
  a
-> MockChainSt
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] 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 [MockChainLogEntry] m))
   a
 -> ExceptT
      MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt))
-> (MockChainT m a
    -> StateT
         MockChainSt
         (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
         a)
-> MockChainT m a
-> ExceptT
     MockChainError (WriterT [MockChainLogEntry] m) (a, MockChainSt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
forall (m :: * -> *) a.
MockChainT m a
-> StateT
     MockChainSt
     (ExceptT MockChainError (WriterT [MockChainLogEntry] m))
     a
unMockChain

-- | Executes a 'MockChainT' from an initial state set up with the given initial
-- value distribution. Similar to 'runMockChainT', uses the default
-- environment. Returns a 'UtxoState' instead of a 'MockChainSt'. If you need
-- the later, use 'runMockChainTRaw'
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), [MockChainLogEntry])
-> (Either MockChainError (a, UtxoState), [MockChainLogEntry])
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), [MockChainLogEntry])
 -> (Either MockChainError (a, UtxoState), [MockChainLogEntry]))
-> m (Either MockChainError (a, MockChainSt), [MockChainLogEntry])
-> m (Either MockChainError (a, UtxoState), [MockChainLogEntry])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockChainT m a
-> m (Either MockChainError (a, MockChainSt), [MockChainLogEntry])
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.
-- The canonical environment uses the default 'SlotConfig'
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
  validatorFromHash :: ValidatorHash -> MockChainT m (Maybe (Versioned Validator))
validatorFromHash ValidatorHash
valHash = (MockChainSt -> Maybe (Versioned Validator))
-> MockChainT m (Maybe (Versioned Validator))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MockChainSt -> Maybe (Versioned Validator))
 -> MockChainT m (Maybe (Versioned Validator)))
-> (MockChainSt -> Maybe (Versioned Validator))
-> MockChainT m (Maybe (Versioned Validator))
forall a b. (a -> b) -> a -> b
$ ValidatorHash
-> Map ValidatorHash (Versioned Validator)
-> Maybe (Versioned Validator)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ValidatorHash
valHash (Map ValidatorHash (Versioned Validator)
 -> Maybe (Versioned Validator))
-> (MockChainSt -> Map ValidatorHash (Versioned Validator))
-> MockChainSt
-> Maybe (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainSt -> Map ValidatorHash (Versioned Validator)
mcstValidators
  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 = [MockChainLogEntry] -> MockChainT m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [MockChainLogEntry
l]

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
s = (MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\MockChainSt
st -> MockChainSt
st {mcstCurrentSlot = max s (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

instance (Monad m) => MonadBlockChain (MockChainT m) where
  validateTxSkel :: TxSkel -> MockChainT m CardanoTx
validateTxSkel skelUnbal :: TxSkel
skelUnbal@TxSkel {[Wallet]
[TxSkelProposal]
[TxSkelOut]
Set TxOutRef
Set TxLabel
TxSkelWithdrawals
Map TxOutRef TxSkelRedeemer
TxSkelMints
SlotRange
TxOpts
txSkelLabel :: Set TxLabel
txSkelOpts :: TxOpts
txSkelMints :: TxSkelMints
txSkelSigners :: [Wallet]
txSkelValidityRange :: SlotRange
txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelInsReference :: Set TxOutRef
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: TxSkelWithdrawals
txSkelLabel :: TxSkel -> Set TxLabel
txSkelOpts :: TxSkel -> TxOpts
txSkelMints :: TxSkel -> TxSkelMints
txSkelSigners :: TxSkel -> [Wallet]
txSkelValidityRange :: TxSkel -> SlotRange
txSkelIns :: TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelInsReference :: TxSkel -> Set TxOutRef
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelWithdrawals :: TxSkel -> TxSkelWithdrawals
..} | 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
txOptAutoReferenceScripts :: Bool
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
txOptAutoReferenceScripts :: TxOpts -> Bool
..} <- TxOpts
txSkelOpts = do
    -- We log the submitted skeleton
    (MockChainSt -> SkelContext) -> MockChainT m SkelContext
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainSt -> SkelContext
mcstToSkelContext MockChainT m SkelContext
-> (SkelContext -> 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
>>= MockChainLogEntry -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> MockChainT m ())
-> (SkelContext -> MockChainLogEntry)
-> SkelContext
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SkelContext -> TxSkel -> MockChainLogEntry
`MCLogSubmittedTxSkel` 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 requested in the skeleton options
    TxSkel
minAdaRefScriptsSkelUnbal <- (if Bool
txOptAutoReferenceScripts then TxSkel -> MockChainT m TxSkel
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m TxSkel
toTxSkelWithReferenceScripts else TxSkel -> MockChainT m TxSkel
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return) 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
    (MockChainSt -> SkelContext) -> MockChainT m SkelContext
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainSt -> SkelContext
mcstToSkelContext MockChainT m SkelContext
-> (SkelContext -> 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
>>= \SkelContext
ctx -> MockChainLogEntry -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> MockChainT m ())
-> MockChainLogEntry -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ SkelContext
-> TxSkel
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> MockChainLogEntry
MCLogAdjustedTxSkel SkelContext
ctx 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
        [DatumHash]
insData <- TxSkel -> MockChainT m [DatumHash]
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m [DatumHash]
txSkelInputDataAsHashes TxSkel
skel
        (MockChainSt -> MockChainSt) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify'
          ( [DatumHash] -> MockChainSt -> MockChainSt
removeDatums [DatumHash]
insData
              (MockChainSt -> MockChainSt)
-> (MockChainSt -> MockChainSt) -> MockChainSt -> MockChainSt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(DatumHash, TxSkelOutDatum)] -> MockChainSt -> MockChainSt
addDatums (TxSkel -> [(DatumHash, TxSkelOutDatum)]
txSkelDataInOutputs TxSkel
skel)
              (MockChainSt -> MockChainSt)
-> (MockChainSt -> MockChainSt) -> MockChainSt -> MockChainSt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ValidatorHash (Versioned Validator)
-> MockChainSt -> MockChainSt
addValidators (TxSkel -> Map ValidatorHash (Versioned Validator)
txSkelValidatorsInOutputs TxSkel
skel Map ValidatorHash (Versioned Validator)
-> Map ValidatorHash (Versioned Validator)
-> Map ValidatorHash (Versioned Validator)
forall a. Semigroup a => a -> a -> a
<> TxSkel -> Map ValidatorHash (Versioned Validator)
txSkelReferenceScripts 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