{-# OPTIONS_GHC -Wno-orphans #-}
module Cooked.MockChain.Staged
( interpretAndRunWith,
interpretAndRun,
StagedMockChain,
MockChainBuiltin,
runTweakFrom,
MonadModalBlockChain,
InterpMockChain,
somewhere,
runTweak,
everywhere,
withTweak,
there,
)
where
import Cardano.Node.Emulator qualified as Emulator
import Control.Applicative
import Control.Monad (MonadPlus (..), msum)
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Cooked.InitialDistribution
import Cooked.Ltl
import Cooked.MockChain.BlockChain
import Cooked.MockChain.Direct
import Cooked.Pretty.Hashable
import Cooked.Skeleton
import Cooked.Tweak.Common
import Data.Default
import Ledger.Slot qualified as Ledger
import Ledger.Tx qualified as Ledger
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api
interpretAndRunWith ::
(forall m. (Monad m) => MockChainT m a -> m res) ->
StagedMockChain a ->
[res]
interpretAndRunWith :: forall a res.
(forall (m :: * -> *). Monad m => MockChainT m a -> m res)
-> StagedMockChain a -> [res]
interpretAndRunWith forall (m :: * -> *). Monad m => MockChainT m a -> m res
f StagedMockChain a
smc = MockChainT [] a -> [res]
forall (m :: * -> *). Monad m => MockChainT m a -> m res
f (MockChainT [] a -> [res]) -> MockChainT [] a -> [res]
forall a b. (a -> b) -> a -> b
$ StagedMockChain a -> MockChainT [] a
forall a. StagedMockChain a -> InterpMockChain a
interpret StagedMockChain a
smc
interpretAndRun :: StagedMockChain a -> [MockChainReturn a]
interpretAndRun :: forall a. StagedMockChain a -> [MockChainReturn a]
interpretAndRun = (forall (m :: * -> *).
Monad m =>
MockChainT m a -> m (MockChainReturn a))
-> StagedMockChain a -> [MockChainReturn a]
forall a res.
(forall (m :: * -> *). Monad m => MockChainT m a -> m res)
-> StagedMockChain a -> [res]
interpretAndRunWith MockChainT m a -> m (MockChainReturn a)
forall (m :: * -> *).
Monad m =>
MockChainT m a -> m (MockChainReturn a)
forall (m :: * -> *) a.
Monad m =>
MockChainT m a -> m (MockChainReturn a)
runMockChainT
type InterpMockChain = MockChainT []
interpret :: StagedMockChain a -> InterpMockChain a
interpret :: forall a. StagedMockChain a -> InterpMockChain a
interpret = (StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> [Ltl (UntypedTweak (MockChainT []))] -> InterpMockChain a)
-> [Ltl (UntypedTweak (MockChainT []))]
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> InterpMockChain a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> [Ltl (UntypedTweak (MockChainT []))] -> InterpMockChain a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT [] (StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> InterpMockChain a)
-> (StagedMockChain a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a)
-> StagedMockChain a
-> InterpMockChain a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall modification (builtin :: * -> *) (m :: * -> *) a.
InterpLtl modification builtin m =>
Staged (LtlOp modification builtin) a
-> StateT [Ltl modification] m a
interpLtlAndPruneUnfinished
data MockChainBuiltin a where
GetParams :: MockChainBuiltin Emulator.Params
SetParams :: Emulator.Params -> MockChainBuiltin ()
ValidateTxSkel :: TxSkel -> MockChainBuiltin Ledger.CardanoTx
TxOutByRef :: Api.TxOutRef -> MockChainBuiltin (Maybe TxSkelOut)
WaitNSlots :: (Integral i) => i -> MockChainBuiltin Ledger.Slot
AllUtxos :: MockChainBuiltin [(Api.TxOutRef, TxSkelOut)]
UtxosAt :: (Script.ToAddress a) => a -> MockChainBuiltin [(Api.TxOutRef, TxSkelOut)]
LogEvent :: MockChainLogEntry -> MockChainBuiltin ()
Define :: (ToHash a) => String -> a -> MockChainBuiltin a
SetConstitutionScript :: (Script.ToVersioned Script.Script s) => s -> MockChainBuiltin ()
GetConstitutionScript :: MockChainBuiltin (Maybe (Script.Versioned Script.Script))
RegisterStakingCred :: (Script.ToCredential c) => c -> Integer -> Integer -> MockChainBuiltin ()
Empty :: MockChainBuiltin a
Alt :: StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
Fail :: String -> MockChainBuiltin a
ThrowError :: MockChainError -> MockChainBuiltin a
CatchError :: StagedMockChain a -> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
type StagedMockChain = Staged (LtlOp (UntypedTweak InterpMockChain) MockChainBuiltin)
instance Alternative StagedMockChain where
empty :: forall a. StagedMockChain a
empty = LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin a
-> (a
-> Staged
(LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a)
-> Staged (LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a
forall (op :: * -> *) a1 a.
op a1 -> (a1 -> Staged op a) -> Staged op a
Instr (MockChainBuiltin a
-> LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin a
forall (builtin :: * -> *) a modification.
builtin a -> LtlOp modification builtin a
Builtin MockChainBuiltin a
forall a. MockChainBuiltin a
Empty) a
-> Staged (LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a
forall a (op :: * -> *). a -> Staged op a
Return
StagedMockChain a
a <|> :: forall a.
StagedMockChain a -> StagedMockChain a -> StagedMockChain a
<|> StagedMockChain a
b = LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin a
-> (a -> StagedMockChain a) -> StagedMockChain a
forall (op :: * -> *) a1 a.
op a1 -> (a1 -> Staged op a) -> Staged op a
Instr (MockChainBuiltin a
-> LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin a
forall (builtin :: * -> *) a modification.
builtin a -> LtlOp modification builtin a
Builtin (StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
forall a.
StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
Alt StagedMockChain a
a StagedMockChain a
b)) a -> StagedMockChain a
forall a (op :: * -> *). a -> Staged op a
Return
instance MonadFail StagedMockChain where
fail :: forall a. String -> StagedMockChain a
fail String
msg = LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin a
-> (a
-> Staged
(LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a)
-> Staged (LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a
forall (op :: * -> *) a1 a.
op a1 -> (a1 -> Staged op a) -> Staged op a
Instr (MockChainBuiltin a
-> LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin a
forall (builtin :: * -> *) a modification.
builtin a -> LtlOp modification builtin a
Builtin (String -> MockChainBuiltin a
forall a. String -> MockChainBuiltin a
Fail String
msg)) a
-> Staged (LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a
forall a (op :: * -> *). a -> Staged op a
Return
instance (MonadPlus m) => MonadPlus (MockChainT m) where
mzero :: forall a. MockChainT m a
mzero = m a -> MockChainT m a
forall (m :: * -> *) a. Monad m => m a -> MockChainT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
mplus :: forall a. MockChainT m a -> MockChainT m a -> MockChainT m a
mplus = (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 (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance InterpLtl (UntypedTweak InterpMockChain) MockChainBuiltin InterpMockChain where
interpBuiltin :: forall a.
MockChainBuiltin a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
interpBuiltin MockChainBuiltin a
GetParams = StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
interpBuiltin (SetParams Params
params) = Params
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) ()
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Params -> m ()
setParams Params
params
interpBuiltin (ValidateTxSkel TxSkel
skel) =
StateT
[Ltl (UntypedTweak (MockChainT []))]
(MockChainT [])
[Ltl (UntypedTweak (MockChainT []))]
forall s (m :: * -> *). MonadState s m => m s
get
StateT
[Ltl (UntypedTweak (MockChainT []))]
(MockChainT [])
[Ltl (UntypedTweak (MockChainT []))]
-> ([Ltl (UntypedTweak (MockChainT []))]
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a)
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall a b.
StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> (a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) b)
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a]
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
([StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a]
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a)
-> ([Ltl (UntypedTweak (MockChainT []))]
-> [StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a])
-> [Ltl (UntypedTweak (MockChainT []))]
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UntypedTweak (MockChainT []),
[Ltl (UntypedTweak (MockChainT []))])
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a)
-> [(UntypedTweak (MockChainT []),
[Ltl (UntypedTweak (MockChainT []))])]
-> [StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a]
forall a b. (a -> b) -> [a] -> [b]
map ((UntypedTweak (MockChainT [])
-> [Ltl (UntypedTweak (MockChainT []))]
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a)
-> (UntypedTweak (MockChainT []),
[Ltl (UntypedTweak (MockChainT []))])
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UntypedTweak (MockChainT [])
-> [Ltl (UntypedTweak (MockChainT []))]
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
UntypedTweak (MockChainT [])
-> [Ltl (UntypedTweak (MockChainT []))]
-> StateT
[Ltl (UntypedTweak (MockChainT []))] (MockChainT []) CardanoTx
interpretNow)
([(UntypedTweak (MockChainT []),
[Ltl (UntypedTweak (MockChainT []))])]
-> [StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a])
-> ([Ltl (UntypedTweak (MockChainT []))]
-> [(UntypedTweak (MockChainT []),
[Ltl (UntypedTweak (MockChainT []))])])
-> [Ltl (UntypedTweak (MockChainT []))]
-> [StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ltl (UntypedTweak (MockChainT []))]
-> [(UntypedTweak (MockChainT []),
[Ltl (UntypedTweak (MockChainT []))])]
forall a. Monoid a => [Ltl a] -> [(a, [Ltl a])]
nowLaterList
where
interpretNow ::
UntypedTweak InterpMockChain ->
[Ltl (UntypedTweak InterpMockChain)] ->
StateT [Ltl (UntypedTweak InterpMockChain)] InterpMockChain Ledger.CardanoTx
interpretNow :: UntypedTweak (MockChainT [])
-> [Ltl (UntypedTweak (MockChainT []))]
-> StateT
[Ltl (UntypedTweak (MockChainT []))] (MockChainT []) CardanoTx
interpretNow (UntypedTweak Tweak (MockChainT []) a
now) [Ltl (UntypedTweak (MockChainT []))]
later = do
(a
_, TxSkel
skel') <- InterpMockChain (a, TxSkel)
-> StateT
[Ltl (UntypedTweak (MockChainT []))] (MockChainT []) (a, TxSkel)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT [Ltl (UntypedTweak (MockChainT []))] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (InterpMockChain (a, TxSkel)
-> StateT
[Ltl (UntypedTweak (MockChainT []))] (MockChainT []) (a, TxSkel))
-> InterpMockChain (a, TxSkel)
-> StateT
[Ltl (UntypedTweak (MockChainT []))] (MockChainT []) (a, TxSkel)
forall a b. (a -> b) -> a -> b
$ Tweak (MockChainT []) a -> TxSkel -> InterpMockChain (a, TxSkel)
forall (m :: * -> *) a.
MonadPlus m =>
Tweak m a -> TxSkel -> m (a, TxSkel)
runTweakInChain Tweak (MockChainT []) a
now TxSkel
skel
[Ltl (UntypedTweak (MockChainT []))]
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ltl (UntypedTweak (MockChainT []))]
later
TxSkel
-> StateT
[Ltl (UntypedTweak (MockChainT []))] (MockChainT []) CardanoTx
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m CardanoTx
validateTxSkel TxSkel
skel'
interpBuiltin (TxOutByRef TxOutRef
o) = TxOutRef
-> StateT
[Ltl (UntypedTweak (MockChainT []))]
(MockChainT [])
(Maybe TxSkelOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxSkelOut)
txOutByRef TxOutRef
o
interpBuiltin (WaitNSlots i
s) = i
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) Slot
forall i.
Integral i =>
i
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) Slot
forall (m :: * -> *) i.
(MonadBlockChainWithoutValidation m, Integral i) =>
i -> m Slot
waitNSlots i
s
interpBuiltin MockChainBuiltin a
AllUtxos = StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
StateT
[Ltl (UntypedTweak (MockChainT []))]
(MockChainT [])
[(TxOutRef, TxSkelOut)]
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m [(TxOutRef, TxSkelOut)]
allUtxos
interpBuiltin (UtxosAt a
address) = a
-> StateT
[Ltl (UntypedTweak (MockChainT []))]
(MockChainT [])
[(TxOutRef, TxSkelOut)]
forall a.
ToAddress a =>
a
-> StateT
[Ltl (UntypedTweak (MockChainT []))]
(MockChainT [])
[(TxOutRef, TxSkelOut)]
forall (m :: * -> *) a.
(MonadBlockChainBalancing m, ToAddress a) =>
a -> m [(TxOutRef, TxSkelOut)]
utxosAt a
address
interpBuiltin MockChainBuiltin a
Empty = StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall a.
StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
interpBuiltin (Alt StagedMockChain a
l StagedMockChain a
r) = StagedMockChain a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall modification (builtin :: * -> *) (m :: * -> *) a.
InterpLtl modification builtin m =>
Staged (LtlOp modification builtin) a
-> StateT [Ltl modification] m a
interpLtl StagedMockChain a
l StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall a.
StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` StagedMockChain a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall modification (builtin :: * -> *) (m :: * -> *) a.
InterpLtl modification builtin m =>
Staged (LtlOp modification builtin) a
-> StateT [Ltl modification] m a
interpLtl StagedMockChain a
r
interpBuiltin (Fail String
msg) = String
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall a.
String
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
interpBuiltin (ThrowError MockChainError
err) = MockChainError
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall a.
MockChainError
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MockChainError
err
interpBuiltin (CatchError StagedMockChain a
act MockChainError -> StagedMockChain a
handler) = StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> (MockChainError
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a)
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall a.
StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
-> (MockChainError
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a)
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (StagedMockChain a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall modification (builtin :: * -> *) (m :: * -> *) a.
InterpLtl modification builtin m =>
Staged (LtlOp modification builtin) a
-> StateT [Ltl modification] m a
interpLtl StagedMockChain a
act) (StagedMockChain a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall modification (builtin :: * -> *) (m :: * -> *) a.
InterpLtl modification builtin m =>
Staged (LtlOp modification builtin) a
-> StateT [Ltl modification] m a
interpLtl (StagedMockChain a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a)
-> (MockChainError -> StagedMockChain a)
-> MockChainError
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainError -> StagedMockChain a
handler)
interpBuiltin (LogEvent MockChainLogEntry
entry) = MockChainLogEntry
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent MockChainLogEntry
entry
interpBuiltin (Define String
name a
hash) = String
-> a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall a.
ToHash a =>
String
-> a
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
forall (m :: * -> *) a.
(MonadBlockChainWithoutValidation m, ToHash a) =>
String -> a -> m a
define String
name a
hash
interpBuiltin (SetConstitutionScript s
script) = s -> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) ()
forall s.
ToVersioned Script s =>
s -> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) ()
forall (m :: * -> *) s.
(MonadBlockChainWithoutValidation m, ToVersioned Script s) =>
s -> m ()
setConstitutionScript s
script
interpBuiltin MockChainBuiltin a
GetConstitutionScript = StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) a
StateT
[Ltl (UntypedTweak (MockChainT []))]
(MockChainT [])
(Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m (Maybe (Versioned Script))
getConstitutionScript
interpBuiltin (RegisterStakingCred c
cred Integer
reward Integer
deposit) = c
-> Integer
-> Integer
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) ()
forall c.
ToCredential c =>
c
-> Integer
-> Integer
-> StateT [Ltl (UntypedTweak (MockChainT []))] (MockChainT []) ()
forall (m :: * -> *) c.
(MonadBlockChainWithoutValidation m, ToCredential c) =>
c -> Integer -> Integer -> m ()
registerStakingCred c
cred Integer
reward Integer
deposit
runTweak :: Tweak InterpMockChain a -> TxSkel -> [MockChainReturn (a, TxSkel)]
runTweak :: forall a.
Tweak (MockChainT []) a -> TxSkel -> [MockChainReturn (a, TxSkel)]
runTweak = InitialDistribution
-> Tweak (MockChainT []) a
-> TxSkel
-> [MockChainReturn (a, TxSkel)]
forall a.
InitialDistribution
-> Tweak (MockChainT []) a
-> TxSkel
-> [MockChainReturn (a, TxSkel)]
runTweakFrom InitialDistribution
forall a. Default a => a
def
runTweakFrom :: InitialDistribution -> Tweak InterpMockChain a -> TxSkel -> [MockChainReturn (a, TxSkel)]
runTweakFrom :: forall a.
InitialDistribution
-> Tweak (MockChainT []) a
-> TxSkel
-> [MockChainReturn (a, TxSkel)]
runTweakFrom InitialDistribution
initDist Tweak (MockChainT []) a
tweak = InitialDistribution
-> MockChainT [] (a, TxSkel) -> [MockChainReturn (a, TxSkel)]
forall (m :: * -> *) a.
Monad m =>
InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
runMockChainTFrom InitialDistribution
initDist (MockChainT [] (a, TxSkel) -> [MockChainReturn (a, TxSkel)])
-> (TxSkel -> MockChainT [] (a, TxSkel))
-> TxSkel
-> [MockChainReturn (a, TxSkel)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak (MockChainT []) a -> TxSkel -> MockChainT [] (a, TxSkel)
forall (m :: * -> *) a.
MonadPlus m =>
Tweak m a -> TxSkel -> m (a, TxSkel)
runTweakInChain Tweak (MockChainT []) a
tweak
type MonadModalBlockChain m = (MonadBlockChain m, MonadModal m, Modification m ~ UntypedTweak InterpMockChain)
somewhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
somewhere :: forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Tweak (MockChainT []) b -> m a -> m a
somewhere = Ltl (Modification m) -> m a -> m a
Ltl (UntypedTweak (MockChainT [])) -> m a -> m a
forall a. Ltl (Modification m) -> m a -> m a
forall (m :: * -> *) a.
MonadModal m =>
Ltl (Modification m) -> m a -> m a
modifyLtl (Ltl (UntypedTweak (MockChainT [])) -> m a -> m a)
-> (Tweak (MockChainT []) b -> Ltl (UntypedTweak (MockChainT [])))
-> Tweak (MockChainT []) b
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ltl (UntypedTweak (MockChainT []))
-> Ltl (UntypedTweak (MockChainT []))
-> Ltl (UntypedTweak (MockChainT []))
forall a. Ltl a -> Ltl a -> Ltl a
LtlUntil Ltl (UntypedTweak (MockChainT []))
forall a. Ltl a
LtlTruth (Ltl (UntypedTweak (MockChainT []))
-> Ltl (UntypedTweak (MockChainT [])))
-> (Tweak (MockChainT []) b -> Ltl (UntypedTweak (MockChainT [])))
-> Tweak (MockChainT []) b
-> Ltl (UntypedTweak (MockChainT []))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UntypedTweak (MockChainT []) -> Ltl (UntypedTweak (MockChainT []))
forall a. a -> Ltl a
LtlAtom (UntypedTweak (MockChainT [])
-> Ltl (UntypedTweak (MockChainT [])))
-> (Tweak (MockChainT []) b -> UntypedTweak (MockChainT []))
-> Tweak (MockChainT []) b
-> Ltl (UntypedTweak (MockChainT []))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak (MockChainT []) b -> UntypedTweak (MockChainT [])
forall (m :: * -> *) a. Tweak m a -> UntypedTweak m
UntypedTweak
everywhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
everywhere :: forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Tweak (MockChainT []) b -> m a -> m a
everywhere = Ltl (Modification m) -> m a -> m a
Ltl (UntypedTweak (MockChainT [])) -> m a -> m a
forall a. Ltl (Modification m) -> m a -> m a
forall (m :: * -> *) a.
MonadModal m =>
Ltl (Modification m) -> m a -> m a
modifyLtl (Ltl (UntypedTweak (MockChainT [])) -> m a -> m a)
-> (Tweak (MockChainT []) b -> Ltl (UntypedTweak (MockChainT [])))
-> Tweak (MockChainT []) b
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ltl (UntypedTweak (MockChainT []))
-> Ltl (UntypedTweak (MockChainT []))
-> Ltl (UntypedTweak (MockChainT []))
forall a. Ltl a -> Ltl a -> Ltl a
LtlRelease Ltl (UntypedTweak (MockChainT []))
forall a. Ltl a
LtlFalsity (Ltl (UntypedTweak (MockChainT []))
-> Ltl (UntypedTweak (MockChainT [])))
-> (Tweak (MockChainT []) b -> Ltl (UntypedTweak (MockChainT [])))
-> Tweak (MockChainT []) b
-> Ltl (UntypedTweak (MockChainT []))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UntypedTweak (MockChainT []) -> Ltl (UntypedTweak (MockChainT []))
forall a. a -> Ltl a
LtlAtom (UntypedTweak (MockChainT [])
-> Ltl (UntypedTweak (MockChainT [])))
-> (Tweak (MockChainT []) b -> UntypedTweak (MockChainT []))
-> Tweak (MockChainT []) b
-> Ltl (UntypedTweak (MockChainT []))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak (MockChainT []) b -> UntypedTweak (MockChainT [])
forall (m :: * -> *) a. Tweak m a -> UntypedTweak m
UntypedTweak
there :: (MonadModalBlockChain m) => Integer -> Tweak InterpMockChain b -> m a -> m a
there :: forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Integer -> Tweak (MockChainT []) b -> m a -> m a
there Integer
n = Ltl (Modification m) -> m a -> m a
Ltl (UntypedTweak (MockChainT [])) -> m a -> m a
forall a. Ltl (Modification m) -> m a -> m a
forall (m :: * -> *) a.
MonadModal m =>
Ltl (Modification m) -> m a -> m a
modifyLtl (Ltl (UntypedTweak (MockChainT [])) -> m a -> m a)
-> (Tweak (MockChainT []) b -> Ltl (UntypedTweak (MockChainT [])))
-> Tweak (MockChainT []) b
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer
-> Tweak (MockChainT []) b -> Ltl (UntypedTweak (MockChainT []))
forall {t} {m :: * -> *} {a}.
(Eq t, Num t) =>
t -> Tweak m a -> Ltl (UntypedTweak m)
mkLtlFormula Integer
n
where
mkLtlFormula :: t -> Tweak m a -> Ltl (UntypedTweak m)
mkLtlFormula t
x =
if t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
then UntypedTweak m -> Ltl (UntypedTweak m)
forall a. a -> Ltl a
LtlAtom (UntypedTweak m -> Ltl (UntypedTweak m))
-> (Tweak m a -> UntypedTweak m)
-> Tweak m a
-> Ltl (UntypedTweak m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak m a -> UntypedTweak m
forall (m :: * -> *) a. Tweak m a -> UntypedTweak m
UntypedTweak
else Ltl (UntypedTweak m) -> Ltl (UntypedTweak m)
forall a. Ltl a -> Ltl a
LtlNext (Ltl (UntypedTweak m) -> Ltl (UntypedTweak m))
-> (Tweak m a -> Ltl (UntypedTweak m))
-> Tweak m a
-> Ltl (UntypedTweak m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Tweak m a -> Ltl (UntypedTweak m)
mkLtlFormula (t
x t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
withTweak :: (MonadModalBlockChain m) => m x -> Tweak InterpMockChain a -> m x
withTweak :: forall (m :: * -> *) x a.
MonadModalBlockChain m =>
m x -> Tweak (MockChainT []) a -> m x
withTweak = (Tweak (MockChainT []) a -> m x -> m x)
-> m x -> Tweak (MockChainT []) a -> m x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Integer -> Tweak (MockChainT []) a -> m x -> m x
forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Integer -> Tweak (MockChainT []) b -> m a -> m a
there Integer
0)
singletonBuiltin :: builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin :: forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin builtin a
b = LtlOp modification builtin a
-> (a -> Staged (LtlOp modification builtin) a)
-> Staged (LtlOp modification builtin) a
forall (op :: * -> *) a1 a.
op a1 -> (a1 -> Staged op a) -> Staged op a
Instr (builtin a -> LtlOp modification builtin a
forall (builtin :: * -> *) a modification.
builtin a -> LtlOp modification builtin a
Builtin builtin a
b) a -> Staged (LtlOp modification builtin) a
forall a (op :: * -> *). a -> Staged op a
Return
instance MonadError MockChainError StagedMockChain where
throwError :: forall a. MockChainError -> StagedMockChain a
throwError = MockChainBuiltin a
-> Staged (LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin a
-> Staged
(LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a)
-> (MockChainError -> MockChainBuiltin a)
-> MockChainError
-> Staged (LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainError -> MockChainBuiltin a
forall a. MockChainError -> MockChainBuiltin a
ThrowError
catchError :: forall a.
StagedMockChain a
-> (MockChainError -> StagedMockChain a) -> StagedMockChain a
catchError StagedMockChain a
act MockChainError -> StagedMockChain a
handler = MockChainBuiltin a -> StagedMockChain a
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin a -> StagedMockChain a)
-> MockChainBuiltin a -> StagedMockChain a
forall a b. (a -> b) -> a -> b
$ StagedMockChain a
-> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
forall a.
StagedMockChain a
-> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
CatchError StagedMockChain a
act MockChainError -> StagedMockChain a
handler
instance MonadBlockChainBalancing StagedMockChain where
getParams :: StagedMockChain Params
getParams = MockChainBuiltin Params -> StagedMockChain Params
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin MockChainBuiltin Params
GetParams
txOutByRef :: TxOutRef -> StagedMockChain (Maybe TxSkelOut)
txOutByRef = MockChainBuiltin (Maybe TxSkelOut)
-> StagedMockChain (Maybe TxSkelOut)
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin (Maybe TxSkelOut)
-> StagedMockChain (Maybe TxSkelOut))
-> (TxOutRef -> MockChainBuiltin (Maybe TxSkelOut))
-> TxOutRef
-> StagedMockChain (Maybe TxSkelOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> MockChainBuiltin (Maybe TxSkelOut)
TxOutByRef
utxosAt :: forall a.
ToAddress a =>
a -> StagedMockChain [(TxOutRef, TxSkelOut)]
utxosAt = MockChainBuiltin [(TxOutRef, TxSkelOut)]
-> StagedMockChain [(TxOutRef, TxSkelOut)]
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin [(TxOutRef, TxSkelOut)]
-> StagedMockChain [(TxOutRef, TxSkelOut)])
-> (a -> MockChainBuiltin [(TxOutRef, TxSkelOut)])
-> a
-> StagedMockChain [(TxOutRef, TxSkelOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MockChainBuiltin [(TxOutRef, TxSkelOut)]
forall c.
ToAddress c =>
c -> MockChainBuiltin [(TxOutRef, TxSkelOut)]
UtxosAt
logEvent :: MockChainLogEntry -> StagedMockChain ()
logEvent = MockChainBuiltin () -> StagedMockChain ()
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin () -> StagedMockChain ())
-> (MockChainLogEntry -> MockChainBuiltin ())
-> MockChainLogEntry
-> StagedMockChain ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainLogEntry -> MockChainBuiltin ()
LogEvent
instance MonadBlockChainWithoutValidation StagedMockChain where
allUtxos :: StagedMockChain [(TxOutRef, TxSkelOut)]
allUtxos = MockChainBuiltin [(TxOutRef, TxSkelOut)]
-> StagedMockChain [(TxOutRef, TxSkelOut)]
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin MockChainBuiltin [(TxOutRef, TxSkelOut)]
AllUtxos
setParams :: Params -> StagedMockChain ()
setParams = MockChainBuiltin () -> StagedMockChain ()
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin () -> StagedMockChain ())
-> (Params -> MockChainBuiltin ()) -> Params -> StagedMockChain ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> MockChainBuiltin ()
SetParams
waitNSlots :: forall i. Integral i => i -> StagedMockChain Slot
waitNSlots = MockChainBuiltin Slot -> StagedMockChain Slot
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin Slot -> StagedMockChain Slot)
-> (i -> MockChainBuiltin Slot) -> i -> StagedMockChain Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> MockChainBuiltin Slot
forall c. Integral c => c -> MockChainBuiltin Slot
WaitNSlots
define :: forall a. ToHash a => String -> a -> StagedMockChain a
define String
name = MockChainBuiltin a
-> Staged (LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin a
-> Staged
(LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a)
-> (a -> MockChainBuiltin a)
-> a
-> Staged (LtlOp (UntypedTweak (MockChainT [])) MockChainBuiltin) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> MockChainBuiltin a
forall a. ToHash a => String -> a -> MockChainBuiltin a
Define String
name
setConstitutionScript :: forall s. ToVersioned Script s => s -> StagedMockChain ()
setConstitutionScript = MockChainBuiltin () -> StagedMockChain ()
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin () -> StagedMockChain ())
-> (s -> MockChainBuiltin ()) -> s -> StagedMockChain ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> MockChainBuiltin ()
forall c. ToVersioned Script c => c -> MockChainBuiltin ()
SetConstitutionScript
getConstitutionScript :: StagedMockChain (Maybe (Versioned Script))
getConstitutionScript = MockChainBuiltin (Maybe (Versioned Script))
-> StagedMockChain (Maybe (Versioned Script))
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin MockChainBuiltin (Maybe (Versioned Script))
GetConstitutionScript
registerStakingCred :: forall c.
ToCredential c =>
c -> Integer -> Integer -> StagedMockChain ()
registerStakingCred c
cred Integer
reward Integer
deposit = MockChainBuiltin () -> StagedMockChain ()
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin () -> StagedMockChain ())
-> MockChainBuiltin () -> StagedMockChain ()
forall a b. (a -> b) -> a -> b
$ c -> Integer -> Integer -> MockChainBuiltin ()
forall c.
ToCredential c =>
c -> Integer -> Integer -> MockChainBuiltin ()
RegisterStakingCred c
cred Integer
reward Integer
deposit
instance MonadBlockChain StagedMockChain where
validateTxSkel :: TxSkel -> StagedMockChain CardanoTx
validateTxSkel = MockChainBuiltin CardanoTx -> StagedMockChain CardanoTx
forall (builtin :: * -> *) a modification.
builtin a -> Staged (LtlOp modification builtin) a
singletonBuiltin (MockChainBuiltin CardanoTx -> StagedMockChain CardanoTx)
-> (TxSkel -> MockChainBuiltin CardanoTx)
-> TxSkel
-> StagedMockChain CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> MockChainBuiltin CardanoTx
ValidateTxSkel