module Cooked.MockChain.Direct where
import Cardano.Api.Shelley qualified as Cardano
import Cardano.Ledger.BaseTypes qualified as Cardano
import Cardano.Ledger.Coin qualified as Cardano
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Applicative
import Control.Lens qualified as Lens
import Control.Monad
import Control.Monad.Except
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Monad.State.Strict
import Control.Monad.Writer
import Cooked.InitialDistribution
import Cooked.MockChain.AutoReferenceScripts
import Cooked.MockChain.Balancing
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx
import Cooked.MockChain.GenerateTx.Common
import Cooked.MockChain.MinAda
import Cooked.MockChain.MockChainState
import Cooked.MockChain.UtxoState (UtxoState)
import Cooked.Pretty.Hashable
import Cooked.Skeleton
import Data.Default
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (mapMaybe)
import Ledger.Index qualified as Ledger
import Ledger.Orphans ()
import Ledger.Tx qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api
data MockChainBook = MockChainBook
{
MockChainBook -> [MockChainLogEntry]
mcbJournal :: [MockChainLogEntry],
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
newtype MockChainT m a = MockChainT
{forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain :: (ExceptT MockChainError (StateT MockChainState (WriterT MockChainBook m))) a}
deriving newtype
( (forall a b. (a -> b) -> MockChainT m a -> MockChainT m b)
-> (forall a b. a -> MockChainT m b -> MockChainT m a)
-> Functor (MockChainT m)
forall a b. a -> MockChainT m b -> MockChainT m a
forall a b. (a -> b) -> MockChainT m a -> MockChainT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MockChainT m b -> MockChainT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockChainT m a -> MockChainT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockChainT m a -> MockChainT m b
fmap :: forall a b. (a -> b) -> MockChainT m a -> MockChainT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MockChainT m b -> MockChainT m a
<$ :: forall a b. a -> MockChainT m b -> MockChainT m a
Functor,
Functor (MockChainT m)
Functor (MockChainT m) =>
(forall a. a -> MockChainT m a)
-> (forall a b.
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b)
-> (forall a b c.
(a -> b -> c)
-> MockChainT m a -> MockChainT m b -> MockChainT m c)
-> (forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b)
-> (forall a b. MockChainT m a -> MockChainT m b -> MockChainT m a)
-> Applicative (MockChainT m)
forall a. a -> MockChainT m a
forall a b. MockChainT m a -> MockChainT m b -> MockChainT m a
forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b
forall a b.
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b
forall a b c.
(a -> b -> c) -> MockChainT m a -> MockChainT m b -> MockChainT m c
forall (m :: * -> *). Monad m => Functor (MockChainT m)
forall (m :: * -> *) a. Monad m => a -> MockChainT m a
forall (m :: * -> *) a b.
Monad m =>
MockChainT m a -> MockChainT m b -> MockChainT m a
forall (m :: * -> *) a b.
Monad m =>
MockChainT m a -> MockChainT m b -> MockChainT m b
forall (m :: * -> *) a b.
Monad m =>
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MockChainT m a -> MockChainT m b -> MockChainT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> MockChainT m a
pure :: forall a. a -> MockChainT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b
<*> :: forall a b.
MockChainT m (a -> b) -> MockChainT m a -> MockChainT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MockChainT m a -> MockChainT m b -> MockChainT m c
liftA2 :: forall a b c.
(a -> b -> c) -> MockChainT m a -> MockChainT m b -> MockChainT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
MockChainT m a -> MockChainT m b -> MockChainT m b
*> :: forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
MockChainT m a -> MockChainT m b -> MockChainT m a
<* :: forall a b. MockChainT m a -> MockChainT m b -> MockChainT m a
Applicative,
MonadState MockChainState,
MonadError MockChainError,
MonadWriter MockChainBook
)
type MockChain = MockChainT Identity
instance (Monad m) => Monad (MockChainT m) where
return :: forall a. a -> MockChainT m a
return = a -> MockChainT m a
forall a. a -> MockChainT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
MockChainT ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
x >>= :: forall a b.
MockChainT m a -> (a -> MockChainT m b) -> MockChainT m b
>>= a -> MockChainT m b
f = ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
-> MockChainT m b
forall (m :: * -> *) a.
ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
-> MockChainT m b)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
-> MockChainT m b
forall a b. (a -> b) -> a -> b
$ ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
x ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> (a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
forall a b.
ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> (a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MockChainT m b
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain (MockChainT m b
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b)
-> (a -> MockChainT m b)
-> a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MockChainT m b
f
instance (Monad m) => MonadFail (MockChainT m) where
fail :: forall a. String -> MockChainT m a
fail = MockChainError -> MockChainT m a
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m a)
-> (String -> MockChainError) -> String -> MockChainT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MockChainError
FailWith
instance MonadTrans MockChainT where
lift :: forall (m :: * -> *) a. Monad m => m a -> MockChainT m a
lift = ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
forall (m :: * -> *) a.
ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a)
-> (m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> m a
-> MockChainT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT MockChainState (WriterT MockChainBook m) a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT MockChainError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MockChainState (WriterT MockChainBook m) a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> (m a -> StateT MockChainState (WriterT MockChainBook m) a)
-> m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT MockChainBook m a
-> StateT MockChainState (WriterT MockChainBook m) a
forall (m :: * -> *) a. Monad m => m a -> StateT MockChainState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT MockChainBook m a
-> StateT MockChainState (WriterT MockChainBook m) a)
-> (m a -> WriterT MockChainBook m a)
-> m a
-> StateT MockChainState (WriterT MockChainBook m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> WriterT MockChainBook m a
forall (m :: * -> *) a. Monad m => m a -> WriterT MockChainBook m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (Monad m, Alternative m) => Alternative (MockChainT m) where
empty :: forall a. MockChainT m a
empty = ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
forall (m :: * -> *) a.
ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
forall a b. (a -> b) -> a -> b
$ StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall a b. (a -> b) -> a -> b
$ (MockChainState
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState))
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((MockChainState
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState))
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a))
-> (MockChainState
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState))
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
forall a b. (a -> b) -> a -> b
$ WriterT MockChainBook m (Either MockChainError a, MockChainState)
-> MockChainState
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState)
forall a b. a -> b -> a
const (WriterT MockChainBook m (Either MockChainError a, MockChainState)
-> MockChainState
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState))
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState)
-> MockChainState
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState)
forall a b. (a -> b) -> a -> b
$ m ((Either MockChainError a, MockChainState), MockChainBook)
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT m ((Either MockChainError a, MockChainState), MockChainBook)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
<|> :: forall a. MockChainT m a -> MockChainT m a -> MockChainT m a
(<|>) = (forall a. m a -> m a -> m a)
-> MockChainT m a -> MockChainT m a -> MockChainT m a
forall (m :: * -> *) x.
(forall a. m a -> m a -> m a)
-> MockChainT m x -> MockChainT m x -> MockChainT m x
combineMockChainT m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
combineMockChainT ::
(forall a. m a -> m a -> m a) ->
MockChainT m x ->
MockChainT m x ->
MockChainT m x
combineMockChainT :: forall (m :: * -> *) x.
(forall a. m a -> m a -> m a)
-> MockChainT m x -> MockChainT m x -> MockChainT m x
combineMockChainT forall a. m a -> m a -> m a
f MockChainT m x
ma MockChainT m x
mb = ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> MockChainT m x
forall (m :: * -> *) a.
ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> MockChainT m a
MockChainT (ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> MockChainT m x)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> MockChainT m x
forall a b. (a -> b) -> a -> b
$
StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x)
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
forall a b. (a -> b) -> a -> b
$
(MockChainState
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState))
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((MockChainState
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState))
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x))
-> (MockChainState
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState))
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
forall a b. (a -> b) -> a -> b
$ \MockChainState
s ->
let resA :: m ((Either MockChainError x, MockChainState), MockChainBook)
resA = WriterT MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook))
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall a b. (a -> b) -> a -> b
$ StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> MockChainState
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (MockChainT m x
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain MockChainT m x
ma)) MockChainState
s
resB :: m ((Either MockChainError x, MockChainState), MockChainBook)
resB = WriterT MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook))
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall a b. (a -> b) -> a -> b
$ StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
-> MockChainState
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (MockChainT m x
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) x
forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain MockChainT m x
mb)) MockChainState
s
in m ((Either MockChainError x, MockChainState), MockChainBook)
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m ((Either MockChainError x, MockChainState), MockChainBook)
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState))
-> m ((Either MockChainError x, MockChainState), MockChainBook)
-> WriterT
MockChainBook m (Either MockChainError x, MockChainState)
forall a b. (a -> b) -> a -> b
$ m ((Either MockChainError x, MockChainState), MockChainBook)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
-> m ((Either MockChainError x, MockChainState), MockChainBook)
forall a. m a -> m a -> m a
f m ((Either MockChainError x, MockChainState), MockChainBook)
resA m ((Either MockChainError x, MockChainState), MockChainBook)
resB
data MockChainReturn a = MockChainReturn
{
forall a. MockChainReturn a -> Either MockChainError a
mcrValue :: Either MockChainError a,
forall a. MockChainReturn a -> Map TxOutRef (TxSkelOut, Bool)
mcrOutputs :: Map Api.TxOutRef (TxSkelOut, Bool),
forall a. MockChainReturn a -> UtxoState
mcrUtxoState :: UtxoState,
forall a. MockChainReturn a -> [MockChainLogEntry]
mcrJournal :: [MockChainLogEntry],
forall a. MockChainReturn a -> Map BuiltinByteString String
mcrAliases :: Map Api.BuiltinByteString String
}
runMockChainTRaw ::
(Monad m) =>
MockChainT m a ->
m (MockChainReturn a)
runMockChainTRaw :: forall (m :: * -> *) a.
Monad m =>
MockChainT m a -> m (MockChainReturn a)
runMockChainTRaw = (((Either MockChainError a, MockChainState), MockChainBook)
-> MockChainReturn a)
-> m ((Either MockChainError a, MockChainState), MockChainBook)
-> m (MockChainReturn a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either MockChainError a, MockChainState), MockChainBook)
-> MockChainReturn a
forall {a}.
((Either MockChainError a, MockChainState), MockChainBook)
-> MockChainReturn a
mkMockChainReturn (m ((Either MockChainError a, MockChainState), MockChainBook)
-> m (MockChainReturn a))
-> (MockChainT m a
-> m ((Either MockChainError a, MockChainState), MockChainBook))
-> MockChainT m a
-> m (MockChainReturn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT MockChainBook m (Either MockChainError a, MockChainState)
-> m ((Either MockChainError a, MockChainState), MockChainBook)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT MockChainBook m (Either MockChainError a, MockChainState)
-> m ((Either MockChainError a, MockChainState), MockChainBook))
-> (MockChainT m a
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState))
-> MockChainT m a
-> m ((Either MockChainError a, MockChainState), MockChainBook)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> MockChainState
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState))
-> MockChainState
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> MockChainState
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT MockChainState
forall a. Default a => a
def (StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState))
-> (MockChainT m a
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a))
-> MockChainT m a
-> WriterT
MockChainBook m (Either MockChainError a, MockChainState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a))
-> (MockChainT m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a)
-> MockChainT m a
-> StateT
MockChainState (WriterT MockChainBook m) (Either MockChainError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainT m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
forall (m :: * -> *) a.
MockChainT m a
-> ExceptT
MockChainError (StateT MockChainState (WriterT MockChainBook m)) a
unMockChain
where
mkMockChainReturn :: ((Either MockChainError a, MockChainState), MockChainBook)
-> MockChainReturn a
mkMockChainReturn ((Either MockChainError a
val, MockChainState
st), MockChainBook [MockChainLogEntry]
journal Map BuiltinByteString String
aliases) =
Either MockChainError a
-> Map TxOutRef (TxSkelOut, Bool)
-> UtxoState
-> [MockChainLogEntry]
-> Map BuiltinByteString String
-> MockChainReturn a
forall a.
Either MockChainError a
-> Map TxOutRef (TxSkelOut, Bool)
-> UtxoState
-> [MockChainLogEntry]
-> Map BuiltinByteString String
-> MockChainReturn a
MockChainReturn Either MockChainError a
val (MockChainState -> Map TxOutRef (TxSkelOut, Bool)
mcstOutputs MockChainState
st) (MockChainState -> UtxoState
mcstToUtxoState MockChainState
st) [MockChainLogEntry]
journal Map BuiltinByteString String
aliases
runMockChainTFrom ::
(Monad m) =>
InitialDistribution ->
MockChainT m a ->
m (MockChainReturn a)
runMockChainTFrom :: forall (m :: * -> *) a.
Monad m =>
InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
runMockChainTFrom InitialDistribution
i0 MockChainT m a
s =
MockChainT m a -> m (MockChainReturn a)
forall (m :: * -> *) a.
Monad m =>
MockChainT m a -> m (MockChainReturn a)
runMockChainTRaw (InitialDistribution -> MockChainT m MockChainState
forall (m :: * -> *).
MonadBlockChainBalancing m =>
InitialDistribution -> m MockChainState
mockChainState0From InitialDistribution
i0 MockChainT m MockChainState
-> (MockChainState -> 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
>>= MockChainState -> 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)
runMockChainT :: (Monad m) => MockChainT m a -> m (MockChainReturn a)
runMockChainT :: forall (m :: * -> *) a.
Monad m =>
MockChainT m a -> m (MockChainReturn a)
runMockChainT = InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
forall (m :: * -> *) a.
Monad m =>
InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
runMockChainTFrom InitialDistribution
forall a. Default a => a
def
runMockChainFrom :: InitialDistribution -> MockChain a -> MockChainReturn a
runMockChainFrom :: forall a. InitialDistribution -> MockChain a -> MockChainReturn a
runMockChainFrom InitialDistribution
i0 = Identity (MockChainReturn a) -> MockChainReturn a
forall a. Identity a -> a
runIdentity (Identity (MockChainReturn a) -> MockChainReturn a)
-> (MockChain a -> Identity (MockChainReturn a))
-> MockChain a
-> MockChainReturn a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitialDistribution -> MockChain a -> Identity (MockChainReturn a)
forall (m :: * -> *) a.
Monad m =>
InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
runMockChainTFrom InitialDistribution
i0
runMockChain :: MockChain a -> MockChainReturn a
runMockChain :: forall a. MockChain a -> MockChainReturn a
runMockChain = Identity (MockChainReturn a) -> MockChainReturn a
forall a. Identity a -> a
runIdentity (Identity (MockChainReturn a) -> MockChainReturn a)
-> (MockChain a -> Identity (MockChainReturn a))
-> MockChain a
-> MockChainReturn a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChain a -> Identity (MockChainReturn a)
forall (m :: * -> *) a.
Monad m =>
MockChainT m a -> m (MockChainReturn a)
runMockChainT
instance (Monad m) => MonadBlockChainBalancing (MockChainT m) where
getParams :: MockChainT m Params
getParams = (MockChainState -> Params) -> MockChainT m Params
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainState -> Params
mcstParams
txOutByRef :: TxOutRef -> MockChainT m (Maybe TxSkelOut)
txOutByRef TxOutRef
outref = do
Maybe (TxSkelOut, Bool)
res <- (MockChainState -> Maybe (TxSkelOut, Bool))
-> MockChainT m (Maybe (TxSkelOut, Bool))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MockChainState -> Maybe (TxSkelOut, Bool))
-> MockChainT m (Maybe (TxSkelOut, Bool)))
-> (MockChainState -> Maybe (TxSkelOut, Bool))
-> MockChainT m (Maybe (TxSkelOut, Bool))
forall a b. (a -> b) -> a -> b
$ TxOutRef
-> Map TxOutRef (TxSkelOut, Bool) -> Maybe (TxSkelOut, Bool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
outref (Map TxOutRef (TxSkelOut, Bool) -> Maybe (TxSkelOut, Bool))
-> (MockChainState -> Map TxOutRef (TxSkelOut, Bool))
-> MockChainState
-> Maybe (TxSkelOut, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState -> Map TxOutRef (TxSkelOut, Bool)
mcstOutputs
Maybe TxSkelOut -> MockChainT m (Maybe TxSkelOut)
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TxSkelOut -> MockChainT m (Maybe TxSkelOut))
-> Maybe TxSkelOut -> MockChainT m (Maybe TxSkelOut)
forall a b. (a -> b) -> a -> b
$ case Maybe (TxSkelOut, Bool)
res of
Just (TxSkelOut
txSkelOut, Bool
True) -> TxSkelOut -> Maybe TxSkelOut
forall a. a -> Maybe a
Just TxSkelOut
txSkelOut
Maybe (TxSkelOut, Bool)
_ -> Maybe TxSkelOut
forall a. Maybe a
Nothing
utxosAt :: forall a. ToAddress a => a -> MockChainT m [(TxOutRef, TxSkelOut)]
utxosAt (a -> Address
forall a. ToAddress a => a -> Address
Script.toAddress -> Address
addr) = ((TxOutRef, TxSkelOut) -> Bool)
-> [(TxOutRef, TxSkelOut)] -> [(TxOutRef, TxSkelOut)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
==) (Address -> Bool)
-> ((TxOutRef, TxSkelOut) -> Address)
-> (TxOutRef, TxSkelOut)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelOut -> Address
txSkelOutAddress (TxSkelOut -> Address)
-> ((TxOutRef, TxSkelOut) -> TxSkelOut)
-> (TxOutRef, TxSkelOut)
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxSkelOut) -> TxSkelOut
forall a b. (a, b) -> b
snd) ([(TxOutRef, TxSkelOut)] -> [(TxOutRef, TxSkelOut)])
-> MockChainT m [(TxOutRef, TxSkelOut)]
-> MockChainT m [(TxOutRef, TxSkelOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockChainT m [(TxOutRef, TxSkelOut)]
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m [(TxOutRef, TxSkelOut)]
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, TxSkelOut)]
allUtxos =
(MockChainState -> [(TxOutRef, TxSkelOut)])
-> MockChainT m [(TxOutRef, TxSkelOut)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MockChainState -> [(TxOutRef, TxSkelOut)])
-> MockChainT m [(TxOutRef, TxSkelOut)])
-> (MockChainState -> [(TxOutRef, TxSkelOut)])
-> MockChainT m [(TxOutRef, TxSkelOut)]
forall a b. (a -> b) -> a -> b
$
((TxOutRef, (TxSkelOut, Bool)) -> Maybe (TxOutRef, TxSkelOut))
-> [(TxOutRef, (TxSkelOut, Bool))] -> [(TxOutRef, TxSkelOut)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\(TxOutRef
oRef, (TxSkelOut
txSkelOut, Bool
isAvailable)) -> if Bool
isAvailable then (TxOutRef, TxSkelOut) -> Maybe (TxOutRef, TxSkelOut)
forall a. a -> Maybe a
Just (TxOutRef
oRef, TxSkelOut
txSkelOut) else Maybe (TxOutRef, TxSkelOut)
forall a. Maybe a
Nothing)
([(TxOutRef, (TxSkelOut, Bool))] -> [(TxOutRef, TxSkelOut)])
-> (MockChainState -> [(TxOutRef, (TxSkelOut, Bool))])
-> MockChainState
-> [(TxOutRef, TxSkelOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef (TxSkelOut, Bool) -> [(TxOutRef, (TxSkelOut, Bool))]
forall k a. Map k a -> [(k, a)]
Map.toList
(Map TxOutRef (TxSkelOut, Bool) -> [(TxOutRef, (TxSkelOut, Bool))])
-> (MockChainState -> Map TxOutRef (TxSkelOut, Bool))
-> MockChainState
-> [(TxOutRef, (TxSkelOut, Bool))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState -> Map TxOutRef (TxSkelOut, Bool)
mcstOutputs
setParams :: Params -> MockChainT m ()
setParams Params
params = do
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ Optic A_Lens NoIx MockChainState MockChainState Params Params
-> Params -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx MockChainState MockChainState Params Params
mcstParamsL Params
params
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
mcstLedgerStateL (Params -> EmulatedLedgerState -> EmulatedLedgerState
Emulator.updateStateParams Params
params)
waitNSlots :: forall i. Integral i => i -> MockChainT m Slot
waitNSlots i
n = do
Slot
cs <- (MockChainState -> Slot) -> MockChainT m Slot
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (EmulatedLedgerState -> Slot
forall a. Num a => EmulatedLedgerState -> a
Emulator.getSlot (EmulatedLedgerState -> Slot)
-> (MockChainState -> EmulatedLedgerState)
-> MockChainState
-> Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState -> EmulatedLedgerState
mcstLedgerState)
if
| i
n i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
0 -> Slot -> MockChainT m Slot
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return Slot
cs
| i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
0 -> do
let newSlot :: Slot
newSlot = Slot
cs Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ i -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
mcstLedgerStateL ((EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState -> MockChainState)
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall a b. (a -> b) -> a -> b
$ ASetter EmulatedLedgerState EmulatedLedgerState SlotNo SlotNo
-> SlotNo -> EmulatedLedgerState -> EmulatedLedgerState
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter EmulatedLedgerState EmulatedLedgerState SlotNo SlotNo
Lens' EmulatedLedgerState SlotNo
Emulator.elsSlotL (SlotNo -> EmulatedLedgerState -> EmulatedLedgerState)
-> SlotNo -> EmulatedLedgerState -> EmulatedLedgerState
forall a b. (a -> b) -> a -> b
$ Slot -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral Slot
newSlot)
Slot -> MockChainT m Slot
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return Slot
newSlot
| Bool
otherwise -> MockChainError -> MockChainT m Slot
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m Slot)
-> MockChainError -> MockChainT m Slot
forall a b. (a -> b) -> a -> b
$ Slot -> Slot -> MockChainError
MCEPastSlot Slot
cs (Slot
cs Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ i -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n)
define :: forall a. ToHash a => String -> a -> MockChainT m a
define String
name a
hashable = MockChainBook -> MockChainT m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([MockChainLogEntry]
-> Map BuiltinByteString String -> MockChainBook
MockChainBook [] (BuiltinByteString -> String -> Map BuiltinByteString String
forall k a. k -> a -> Map k a
Map.singleton (a -> BuiltinByteString
forall a. ToHash a => a -> BuiltinByteString
toHash a
hashable) String
name)) MockChainT m () -> MockChainT m a -> MockChainT m a
forall a b. MockChainT m a -> MockChainT m b -> MockChainT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> MockChainT m a
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
hashable
setConstitutionScript :: forall s. ToVersioned Script s => s -> MockChainT m ()
setConstitutionScript (s -> Versioned Script
forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned -> Versioned Script
cScript) = do
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Lens' MockChainState (Maybe (Versioned Script))
mcstConstitutionL Lens' MockChainState (Maybe (Versioned Script))
-> Versioned Script -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Versioned Script
cScript)
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$
Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
mcstLedgerStateL ((EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState -> MockChainState)
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall a b. (a -> b) -> a -> b
$
ASetter
EmulatedLedgerState
EmulatedLedgerState
(StrictMaybe ScriptHash)
(StrictMaybe ScriptHash)
-> StrictMaybe ScriptHash
-> EmulatedLedgerState
-> EmulatedLedgerState
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter
EmulatedLedgerState
EmulatedLedgerState
(StrictMaybe ScriptHash)
(StrictMaybe ScriptHash)
Lens' EmulatedLedgerState (StrictMaybe ScriptHash)
Emulator.elsConstitutionScriptL (StrictMaybe ScriptHash
-> EmulatedLedgerState -> EmulatedLedgerState)
-> StrictMaybe ScriptHash
-> EmulatedLedgerState
-> EmulatedLedgerState
forall a b. (a -> b) -> a -> b
$
(ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
Cardano.SJust (ScriptHash -> StrictMaybe ScriptHash)
-> (Versioned Script -> ScriptHash)
-> Versioned Script
-> StrictMaybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ScriptHash
Cardano.toShelleyScriptHash (ScriptHash -> ScriptHash)
-> (Versioned Script -> ScriptHash)
-> Versioned Script
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioned Script -> ScriptHash
forall a. ToCardanoScriptHash a => a -> ScriptHash
Script.toCardanoScriptHash)
Versioned Script
cScript
getConstitutionScript :: MockChainT m (Maybe (Versioned Script))
getConstitutionScript = (MockChainState -> Maybe (Versioned Script))
-> MockChainT m (Maybe (Versioned Script))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens' MockChainState (Maybe (Versioned Script))
-> MockChainState -> Maybe (Versioned Script)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' MockChainState (Maybe (Versioned Script))
mcstConstitutionL)
registerStakingCred :: forall c.
ToCredential c =>
c -> Integer -> Integer -> MockChainT m ()
registerStakingCred (c -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) Integer
reward Integer
deposit = do
StakeCredential
stakeCredential <-
String
-> (StakeCredential -> StakeCredential)
-> Either ToCardanoError StakeCredential
-> MockChainT m StakeCredential
forall (m :: * -> *) a b.
MonadError MockChainError m =>
String -> (a -> b) -> Either ToCardanoError a -> m b
throwOnToCardanoErrorOrApply
String
"Unable to convert staking credential"
StakeCredential -> StakeCredential
Cardano.toShelleyStakeCredential
(Credential -> Either ToCardanoError StakeCredential
Ledger.toCardanoStakeCredential Credential
cred)
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$
Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
mcstLedgerStateL
( StakeCredential
-> Coin -> Coin -> EmulatedLedgerState -> EmulatedLedgerState
Emulator.registerStakeCredential
StakeCredential
stakeCredential
(Integer -> Coin
Cardano.Coin Integer
reward)
(Integer -> Coin
Cardano.Coin Integer
deposit)
)
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
MockChainLogEntry -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> MockChainT m ())
-> MockChainLogEntry -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ TxSkel -> MockChainLogEntry
MCLogSubmittedTxSkel TxSkel
skelUnbal
Params
oldParams <- MockChainT m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
let newParams :: Params
newParams = Maybe EmulatorParamsModification -> Params -> Params
applyEmulatorParamsModification Maybe EmulatorParamsModification
txOptEmulatorParamsModification Params
oldParams
Params -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Params -> m ()
setParams Params
newParams
TxSkel
minAdaSkelUnbal <- TxSkel -> MockChainT m TxSkel
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m TxSkel
toTxSkelWithMinAda TxSkel
skelUnbal
Maybe (Versioned Script)
constitution <- MockChainT m (Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m (Maybe (Versioned Script))
getConstitutionScript
let minAdaSkelUnbalWithConst :: TxSkel
minAdaSkelUnbalWithConst = Optic A_Traversal NoIx TxSkel TxSkel TxSkelProposal TxSkelProposal
-> (TxSkelProposal -> TxSkelProposal) -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Lens' TxSkel [TxSkelProposal]
txSkelProposalsL Lens' TxSkel [TxSkelProposal]
-> Optic
A_Traversal
NoIx
[TxSkelProposal]
[TxSkelProposal]
TxSkelProposal
TxSkelProposal
-> Optic
A_Traversal NoIx TxSkel TxSkel TxSkelProposal TxSkelProposal
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Traversal
NoIx
[TxSkelProposal]
[TxSkelProposal]
TxSkelProposal
TxSkelProposal
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed) (TxSkelProposal -> Maybe (Versioned Script) -> TxSkelProposal
forall a.
ToVersioned Script a =>
TxSkelProposal -> Maybe a -> TxSkelProposal
`updateConstitution` Maybe (Versioned Script)
constitution) TxSkel
minAdaSkelUnbal
TxSkel
minAdaRefScriptsSkelUnbalWithConst <- TxSkel -> MockChainT m TxSkel
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m TxSkel
toTxSkelWithReferenceScripts TxSkel
minAdaSkelUnbalWithConst
(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
minAdaRefScriptsSkelUnbalWithConst
MockChainLogEntry -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> MockChainT m ())
-> MockChainLogEntry -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ TxSkel
-> Integer -> Maybe (Set TxOutRef, Wallet) -> MockChainLogEntry
MCLogAdjustedTxSkel TxSkel
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
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
EmulatedLedgerState
eLedgerState <- (MockChainState -> EmulatedLedgerState)
-> MockChainT m EmulatedLedgerState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MockChainState -> EmulatedLedgerState
mcstLedgerState
case Params
-> EmulatedLedgerState
-> CardanoTx
-> (EmulatedLedgerState, ValidationResult)
Emulator.validateCardanoTx Params
newParams EmulatedLedgerState
eLedgerState CardanoTx
cardanoTx of
(EmulatedLedgerState
_, Ledger.FailPhase1 CardanoTx
_ ValidationError
err) -> MockChainError -> MockChainT m ()
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m ())
-> MockChainError -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ ValidationPhase -> ValidationError -> MockChainError
MCEValidationError ValidationPhase
Ledger.Phase1 ValidationError
err
(EmulatedLedgerState
newELedgerState, Ledger.FailPhase2 OnChainTx
_ ValidationError
err Value
_) | Just (Set TxOutRef
colInputs, Wallet
retColWallet) <- Maybe (Set TxOutRef, Wallet)
mCollaterals -> do
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
-> EmulatedLedgerState -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
mcstLedgerStateL EmulatedLedgerState
newELedgerState)
Set TxOutRef -> (TxOutRef -> MockChainT m ()) -> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set TxOutRef
colInputs ((TxOutRef -> MockChainT m ()) -> MockChainT m ())
-> (TxOutRef -> MockChainT m ()) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> (TxOutRef -> MockChainState -> MockChainState)
-> TxOutRef
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> MockChainState -> MockChainState
removeOutput
[(TxIn, TxOut)]
-> ((TxIn, TxOut) -> MockChainT m ()) -> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map TxIn TxOut -> [(TxIn, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxIn TxOut -> [(TxIn, TxOut)])
-> Map TxIn TxOut -> [(TxIn, TxOut)]
forall a b. (a -> b) -> a -> b
$ CardanoTx -> Map TxIn TxOut
Ledger.getCardanoTxProducedReturnCollateral CardanoTx
cardanoTx) (((TxIn, TxOut) -> MockChainT m ()) -> MockChainT m ())
-> ((TxIn, TxOut) -> MockChainT m ()) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ \(TxIn
txIn, TxOut
txOut) ->
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> (MockChainState -> MockChainState) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$
TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
addOutput
(TxIn -> TxOutRef
Ledger.fromCardanoTxIn TxIn
txIn)
(Wallet
retColWallet Wallet -> Payable '["Value"] -> TxSkelOut
forall owner (els :: [Symbol]).
OwnerConstrs owner =>
owner -> Payable els -> TxSkelOut
`receives` Value -> Payable '["Value"]
forall a1. ToValue a1 => a1 -> Payable '["Value"]
Value (TxOut -> Value
Api.txOutValue (TxOut -> Value) -> (TxOut -> TxOut) -> TxOut -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx ConwayEra -> TxOut
forall era. TxOut CtxTx era -> TxOut
Ledger.fromCardanoTxOutToPV2TxInfoTxOut (TxOut CtxTx ConwayEra -> TxOut)
-> (TxOut -> TxOut CtxTx ConwayEra) -> TxOut -> TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> TxOut CtxTx ConwayEra
Ledger.getTxOut (TxOut -> Value) -> TxOut -> Value
forall a b. (a -> b) -> a -> b
$ TxOut
txOut))
MockChainError -> MockChainT m ()
forall a. MockChainError -> MockChainT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> MockChainT m ())
-> MockChainError -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ ValidationPhase -> ValidationError -> MockChainError
MCEValidationError ValidationPhase
Ledger.Phase2 ValidationError
err
(EmulatedLedgerState
newELedgerState, Ledger.Success {}) -> do
(MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
-> EmulatedLedgerState -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
mcstLedgerStateL EmulatedLedgerState
newELedgerState)
let utxos :: [TxOutRef]
utxos = TxIn -> TxOutRef
Ledger.fromCardanoTxIn (TxIn -> TxOutRef)
-> ((TxOut, TxIn) -> TxIn) -> (TxOut, TxIn) -> TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut, TxIn) -> TxIn
forall a b. (a, b) -> b
snd ((TxOut, TxIn) -> TxOutRef) -> [(TxOut, TxIn)] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoTx -> [(TxOut, TxIn)]
Ledger.getCardanoTxOutRefs CardanoTx
cardanoTx
[(TxOutRef, TxSkelOut)]
-> ((TxOutRef, TxSkelOut) -> MockChainT m ()) -> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([TxOutRef] -> [TxSkelOut] -> [(TxOutRef, TxSkelOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxOutRef]
utxos (TxSkel -> [TxSkelOut]
txSkelOuts TxSkel
skel)) (((TxOutRef, TxSkelOut) -> MockChainT m ()) -> MockChainT m ())
-> ((TxOutRef, TxSkelOut) -> MockChainT m ()) -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> ((TxOutRef, TxSkelOut) -> MockChainState -> MockChainState)
-> (TxOutRef, TxSkelOut)
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef -> TxSkelOut -> MockChainState -> MockChainState)
-> (TxOutRef, TxSkelOut) -> MockChainState -> MockChainState
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
addOutput
[(TxOutRef, TxSkelRedeemer)]
-> ((TxOutRef, TxSkelRedeemer) -> MockChainT m ())
-> MockChainT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)])
-> Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)]
forall a b. (a -> b) -> a -> b
$ TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelIns TxSkel
skel) (((TxOutRef, TxSkelRedeemer) -> MockChainT m ())
-> MockChainT m ())
-> ((TxOutRef, TxSkelRedeemer) -> MockChainT m ())
-> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((MockChainState -> MockChainState) -> MockChainT m ())
-> ((TxOutRef, TxSkelRedeemer) -> MockChainState -> MockChainState)
-> (TxOutRef, TxSkelRedeemer)
-> MockChainT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> MockChainState -> MockChainState
removeOutput (TxOutRef -> MockChainState -> MockChainState)
-> ((TxOutRef, TxSkelRedeemer) -> TxOutRef)
-> (TxOutRef, TxSkelRedeemer)
-> MockChainState
-> MockChainState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxSkelRedeemer) -> TxOutRef
forall a b. (a, b) -> a
fst
(EmulatedLedgerState
_, Ledger.FailPhase2 {})
| Maybe (Set TxOutRef, Wallet)
Nothing <- Maybe (Set TxOutRef, Wallet)
mCollaterals ->
String -> MockChainT m ()
forall a. String -> MockChainT m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unreachable case when processing validation result, please report a bug at https://github.com/tweag/cooked-validators/issues"
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
$ (MockChainState -> MockChainState) -> MockChainT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
A_Lens
NoIx
MockChainState
MockChainState
EmulatedLedgerState
EmulatedLedgerState
mcstLedgerStateL EmulatedLedgerState -> EmulatedLedgerState
Emulator.nextSlot)
Params -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Params -> m ()
setParams Params
oldParams
MockChainLogEntry -> MockChainT m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> MockChainT m ())
-> MockChainLogEntry -> MockChainT m ()
forall a b. (a -> b) -> a -> b
$ TxId -> Integer -> MockChainLogEntry
MCLogNewTx (TxId -> TxId
Ledger.fromCardanoTxId (TxId -> TxId) -> TxId -> TxId
forall a b. (a -> b) -> a -> b
$ CardanoTx -> TxId
Ledger.getCardanoTxId CardanoTx
cardanoTx) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [(TxOut, TxIn)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(TxOut, TxIn)] -> Int) -> [(TxOut, TxIn)] -> Int
forall a b. (a -> b) -> a -> b
$ CardanoTx -> [(TxOut, TxIn)]
Ledger.getCardanoTxOutRefs CardanoTx
cardanoTx)
CardanoTx -> MockChainT m CardanoTx
forall a. a -> MockChainT m a
forall (m :: * -> *) a. Monad m => a -> m a
return CardanoTx
cardanoTx