-- | This module provides a staged implementation of our `MonadBlockChain`. The
-- motivation is to be able to modify transactions with `Cooked.Tweak`s deployed
-- in time with `Cooked.Ltl` while the computation gets interpreted, and before
-- the transactions are sent for validation.
module Cooked.MockChain.Staged
  ( -- * 'StagedMockChain': An AST of mockchain computations
    MockChainBuiltin,
    InterpMockChain,
    MockChainTweak,
    StagedMockChain,

    -- * Interpreting and running a 'StagedMockChain'
    interpretAndRunWith,
    interpretAndRun,

    -- * Temporal modalities
    MonadModalBlockChain,
    withTweak,
    somewhere,
    somewhere',
    everywhere,
    everywhere',
    there,
    there',
    nowhere,
    nowhere',
    whenAble,
    whenAble',
  )
where

import Cardano.Node.Emulator qualified as Emulator
import Control.Applicative
import Control.Monad
import Control.Monad.Except
import Cooked.Ltl
import Cooked.MockChain.BlockChain
import Cooked.MockChain.Direct
import Cooked.Pretty.Hashable
import Cooked.Skeleton
import Cooked.Tweak.Common
import Ledger.Slot qualified as Ledger
import Ledger.Tx qualified as Ledger
import Plutus.Script.Utils.Address qualified as Script
import PlutusLedgerApi.V3 qualified as Api

-- | Abstract representation of all the builtin functions of a 'MonadBlockChain'
data MockChainBuiltin a where
  -- Builtins of 'MonadBlockChain'
  GetParams :: MockChainBuiltin Emulator.Params
  SetParams :: Emulator.Params -> MockChainBuiltin ()
  ValidateTxSkel :: TxSkel -> MockChainBuiltin Ledger.CardanoTx
  TxSkelOutByRef :: Api.TxOutRef -> MockChainBuiltin 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 :: (ToVScript s) => s -> MockChainBuiltin ()
  GetConstitutionScript :: MockChainBuiltin (Maybe VScript)
  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainBuiltin (Maybe Api.Lovelace)
  ForceOutputs :: [TxSkelOut] -> MockChainBuiltin [Api.TxOutRef]
  -- The empty set of traces
  Empty :: MockChainBuiltin a
  -- The union of two sets of traces
  Alt :: StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
  -- for the 'MonadError MockChainError' instance
  ThrowError :: MockChainError -> MockChainBuiltin a
  CatchError :: StagedMockChain a -> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a

-- | The domain in which 'StagedMockChain' gets interpreted
type InterpMockChain = MockChainT []

-- | Tweaks operating within the 'InterpMockChain' domain
type MockChainTweak = UntypedTweak InterpMockChain

-- | A 'StagedMockChain' is an AST of mockchain builtins wrapped into @LtlOp@ to
-- be subject to @Ltl@ modifications.
type StagedMockChain = StagedLtl MockChainTweak MockChainBuiltin

instance Alternative StagedMockChain where
  empty :: forall a. StagedMockChain a
empty = MockChainBuiltin a -> StagedLtl MockChainTweak MockChainBuiltin a
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin MockChainBuiltin a
forall a. MockChainBuiltin a
Empty
  StagedMockChain a
a <|> :: forall a.
StagedMockChain a -> StagedMockChain a -> StagedMockChain a
<|> StagedMockChain a
b = MockChainBuiltin a -> StagedMockChain a
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin a -> StagedMockChain a)
-> MockChainBuiltin a -> StagedMockChain a
forall a b. (a -> b) -> a -> b
$ StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
forall a.
StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
Alt StagedMockChain a
a StagedMockChain a
b

instance MonadPlus StagedMockChain where
  mzero :: forall a. StagedMockChain a
mzero = Staged (LtlOp MockChainTweak MockChainBuiltin) a
forall a. StagedMockChain a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a.
StagedMockChain a -> StagedMockChain a -> StagedMockChain a
mplus = Staged (LtlOp MockChainTweak MockChainBuiltin) a
-> Staged (LtlOp MockChainTweak MockChainBuiltin) a
-> Staged (LtlOp MockChainTweak MockChainBuiltin) a
forall a.
StagedMockChain a -> StagedMockChain a -> StagedMockChain a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance MonadFail StagedMockChain where
  fail :: forall a. String -> StagedMockChain a
fail = MockChainBuiltin a -> StagedLtl MockChainTweak MockChainBuiltin a
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin a -> StagedLtl MockChainTweak MockChainBuiltin a)
-> (String -> MockChainBuiltin a)
-> String
-> StagedLtl MockChainTweak MockChainBuiltin a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainError -> MockChainBuiltin a
forall a. MockChainError -> MockChainBuiltin a
ThrowError (MockChainError -> MockChainBuiltin a)
-> (String -> MockChainError) -> String -> MockChainBuiltin a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MockChainError
FailWith

instance MonadError MockChainError StagedMockChain where
  throwError :: forall a. MockChainError -> StagedMockChain a
throwError = MockChainBuiltin a -> StagedLtl MockChainTweak MockChainBuiltin a
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin a -> StagedLtl MockChainTweak MockChainBuiltin a)
-> (MockChainError -> MockChainBuiltin a)
-> MockChainError
-> StagedLtl MockChainTweak 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 = MockChainBuiltin a -> StagedMockChain a
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin a -> StagedMockChain a)
-> ((MockChainError -> StagedMockChain a) -> MockChainBuiltin a)
-> (MockChainError -> StagedMockChain a)
-> StagedMockChain a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a
-> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
forall a.
StagedMockChain a
-> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
CatchError StagedMockChain a
act

instance MonadBlockChainBalancing StagedMockChain where
  getParams :: StagedMockChain Params
getParams = MockChainBuiltin Params -> StagedMockChain Params
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin MockChainBuiltin Params
GetParams
  txSkelOutByRef :: TxOutRef -> StagedMockChain TxSkelOut
txSkelOutByRef = MockChainBuiltin TxSkelOut -> StagedMockChain TxSkelOut
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin TxSkelOut -> StagedMockChain TxSkelOut)
-> (TxOutRef -> MockChainBuiltin TxSkelOut)
-> TxOutRef
-> StagedMockChain TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> MockChainBuiltin TxSkelOut
TxSkelOutByRef
  utxosAt :: forall a. ToAddress a => a -> StagedMockChain Utxos
utxosAt = MockChainBuiltin Utxos -> StagedMockChain Utxos
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin Utxos -> StagedMockChain Utxos)
-> (a -> MockChainBuiltin Utxos) -> a -> StagedMockChain Utxos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MockChainBuiltin Utxos
forall c. ToAddress c => c -> MockChainBuiltin Utxos
UtxosAt
  logEvent :: MockChainLogEntry -> StagedMockChain ()
logEvent = MockChainBuiltin () -> StagedMockChain ()
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl 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 Utxos
allUtxos = MockChainBuiltin Utxos -> StagedMockChain Utxos
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin MockChainBuiltin Utxos
AllUtxos
  setParams :: Params -> StagedMockChain ()
setParams = MockChainBuiltin () -> StagedMockChain ()
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl 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 -> StagedLtl 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 -> StagedLtl MockChainTweak MockChainBuiltin a
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin a -> StagedLtl MockChainTweak MockChainBuiltin a)
-> (a -> MockChainBuiltin a)
-> a
-> StagedLtl MockChainTweak 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. ToVScript s => s -> StagedMockChain ()
setConstitutionScript = MockChainBuiltin () -> StagedMockChain ()
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin () -> StagedMockChain ())
-> (s -> MockChainBuiltin ()) -> s -> StagedMockChain ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> MockChainBuiltin ()
forall c. ToVScript c => c -> MockChainBuiltin ()
SetConstitutionScript
  getConstitutionScript :: StagedMockChain (Maybe VScript)
getConstitutionScript = MockChainBuiltin (Maybe VScript) -> StagedMockChain (Maybe VScript)
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin MockChainBuiltin (Maybe VScript)
GetConstitutionScript
  getCurrentReward :: forall c. ToCredential c => c -> StagedMockChain (Maybe Lovelace)
getCurrentReward = MockChainBuiltin (Maybe Lovelace)
-> StagedMockChain (Maybe Lovelace)
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin (Maybe Lovelace)
 -> StagedMockChain (Maybe Lovelace))
-> (c -> MockChainBuiltin (Maybe Lovelace))
-> c
-> StagedMockChain (Maybe Lovelace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> MockChainBuiltin (Maybe Lovelace)
forall c. ToCredential c => c -> MockChainBuiltin (Maybe Lovelace)
GetCurrentReward

instance MonadBlockChain StagedMockChain where
  validateTxSkel :: TxSkel -> StagedMockChain CardanoTx
validateTxSkel = MockChainBuiltin CardanoTx -> StagedMockChain CardanoTx
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl 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
  forceOutputs :: [TxSkelOut] -> StagedMockChain [TxOutRef]
forceOutputs = MockChainBuiltin [TxOutRef] -> StagedMockChain [TxOutRef]
forall (builtin :: * -> *) a modification.
builtin a -> StagedLtl modification builtin a
singletonBuiltin (MockChainBuiltin [TxOutRef] -> StagedMockChain [TxOutRef])
-> ([TxSkelOut] -> MockChainBuiltin [TxOutRef])
-> [TxSkelOut]
-> StagedMockChain [TxOutRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxSkelOut] -> MockChainBuiltin [TxOutRef]
ForceOutputs

instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
  modifyAndInterpBuiltin :: forall a.
MockChainBuiltin a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
modifyAndInterpBuiltin = \case
    MockChainBuiltin a
GetParams -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left InterpMockChain a
MockChainT [] Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
    SetParams Params
params -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ Params -> MockChainT [] ()
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Params -> m ()
setParams Params
params
    ValidateTxSkel TxSkel
skel -> ([Requirement MockChainTweak] -> InterpMockChain a)
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. b -> Either a b
Right (([Requirement MockChainTweak] -> InterpMockChain a)
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> ([Requirement MockChainTweak] -> InterpMockChain a)
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ \[Requirement MockChainTweak]
now -> do
      (()
_, TxSkel
skel') <-
        (Tweak InterpMockChain () -> TxSkel -> MockChainT [] ((), TxSkel)
forall (m :: * -> *) a.
MonadPlus m =>
Tweak m a -> TxSkel -> m (a, TxSkel)
`runTweakInChain` TxSkel
skel) (Tweak InterpMockChain () -> MockChainT [] ((), TxSkel))
-> Tweak InterpMockChain () -> MockChainT [] ((), TxSkel)
forall a b. (a -> b) -> a -> b
$
          (Requirement MockChainTweak
 -> Tweak InterpMockChain () -> Tweak InterpMockChain ())
-> Tweak InterpMockChain ()
-> [Requirement MockChainTweak]
-> Tweak InterpMockChain ()
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            ( \Requirement MockChainTweak
req Tweak InterpMockChain ()
acc -> case Requirement MockChainTweak
req of
                Apply (UntypedTweak Tweak InterpMockChain a
tweak) -> Tweak InterpMockChain a
tweak Tweak InterpMockChain a
-> Tweak InterpMockChain () -> Tweak InterpMockChain ()
forall a b.
StateT TxSkel (ListT InterpMockChain) a
-> StateT TxSkel (ListT InterpMockChain) b
-> StateT TxSkel (ListT InterpMockChain) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tweak InterpMockChain ()
acc
                EnsureFailure (UntypedTweak Tweak InterpMockChain a
tweak) -> Tweak InterpMockChain a -> Tweak InterpMockChain ()
forall (m :: * -> *) a. MonadPlus m => Tweak m a -> Tweak m ()
ensureFailingTweak Tweak InterpMockChain a
tweak Tweak InterpMockChain ()
-> Tweak InterpMockChain () -> Tweak InterpMockChain ()
forall a b.
StateT TxSkel (ListT InterpMockChain) a
-> StateT TxSkel (ListT InterpMockChain) b
-> StateT TxSkel (ListT InterpMockChain) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tweak InterpMockChain ()
acc
            )
            Tweak InterpMockChain ()
forall (m :: * -> *). MonadTweak m => m ()
doNothingTweak
            [Requirement MockChainTweak]
now
      TxSkel -> MockChainT [] CardanoTx
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m CardanoTx
validateTxSkel TxSkel
skel'
    TxSkelOutByRef TxOutRef
o -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> MockChainT [] TxSkelOut
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m TxSkelOut
txSkelOutByRef TxOutRef
o
    WaitNSlots i
s -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ i -> MockChainT [] Slot
forall i. Integral i => i -> MockChainT [] Slot
forall (m :: * -> *) i.
(MonadBlockChainWithoutValidation m, Integral i) =>
i -> m Slot
waitNSlots i
s
    MockChainBuiltin a
AllUtxos -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left InterpMockChain a
MockChainT [] Utxos
forall (m :: * -> *). MonadBlockChainWithoutValidation m => m Utxos
allUtxos
    UtxosAt a
address -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ a -> MockChainT [] Utxos
forall a. ToAddress a => a -> MockChainT [] Utxos
forall (m :: * -> *) a.
(MonadBlockChainBalancing m, ToAddress a) =>
a -> m Utxos
utxosAt a
address
    LogEvent MockChainLogEntry
entry -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ MockChainLogEntry -> MockChainT [] ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent MockChainLogEntry
entry
    Define String
name a
hash -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ String -> a -> InterpMockChain a
forall a. ToHash a => String -> a -> MockChainT [] a
forall (m :: * -> *) a.
(MonadBlockChainWithoutValidation m, ToHash a) =>
String -> a -> m a
define String
name a
hash
    SetConstitutionScript s
script -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ s -> MockChainT [] ()
forall s. ToVScript s => s -> MockChainT [] ()
forall (m :: * -> *) s.
(MonadBlockChainWithoutValidation m, ToVScript s) =>
s -> m ()
setConstitutionScript s
script
    MockChainBuiltin a
GetConstitutionScript -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left InterpMockChain a
MockChainT [] (Maybe VScript)
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m (Maybe VScript)
getConstitutionScript
    GetCurrentReward c
cred -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ c -> MockChainT [] (Maybe Lovelace)
forall c. ToCredential c => c -> MockChainT [] (Maybe Lovelace)
forall (m :: * -> *) c.
(MonadBlockChainWithoutValidation m, ToCredential c) =>
c -> m (Maybe Lovelace)
getCurrentReward c
cred
    ForceOutputs [TxSkelOut]
outs -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ [TxSkelOut] -> MockChainT [] [TxOutRef]
forall (m :: * -> *).
MonadBlockChain m =>
[TxSkelOut] -> m [TxOutRef]
forceOutputs [TxSkelOut]
outs
    MockChainBuiltin a
Empty -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left InterpMockChain a
forall a. MockChainT [] a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Alt StagedMockChain a
l StagedMockChain a
r -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ StagedMockChain a -> InterpMockChain a
forall a.
StagedLtl MockChainTweak MockChainBuiltin a -> MockChainT [] a
forall modification (builtin :: * -> *) (m :: * -> *) a.
(MonadPlus m, ModInterpBuiltin modification builtin m) =>
StagedLtl modification builtin a -> m a
interpStagedLtl StagedMockChain a
l InterpMockChain a -> InterpMockChain a -> InterpMockChain a
forall a. MockChainT [] a -> MockChainT [] a -> MockChainT [] a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` StagedMockChain a -> InterpMockChain a
forall a.
StagedLtl MockChainTweak MockChainBuiltin a -> MockChainT [] a
forall modification (builtin :: * -> *) (m :: * -> *) a.
(MonadPlus m, ModInterpBuiltin modification builtin m) =>
StagedLtl modification builtin a -> m a
interpStagedLtl StagedMockChain a
r
    ThrowError MockChainError
err -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ MockChainError -> InterpMockChain a
forall a. MockChainError -> MockChainT [] a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MockChainError
err
    CatchError StagedMockChain a
act MockChainError -> StagedMockChain a
handler -> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. a -> Either a b
Left (InterpMockChain a
 -> Either
      (InterpMockChain a)
      ([Requirement MockChainTweak] -> InterpMockChain a))
-> InterpMockChain a
-> Either
     (InterpMockChain a)
     ([Requirement MockChainTweak] -> InterpMockChain a)
forall a b. (a -> b) -> a -> b
$ InterpMockChain a
-> (MockChainError -> InterpMockChain a) -> InterpMockChain a
forall a.
MockChainT [] a
-> (MockChainError -> MockChainT [] a) -> MockChainT [] a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (StagedMockChain a -> InterpMockChain a
forall a.
StagedLtl MockChainTweak MockChainBuiltin a -> MockChainT [] a
forall modification (builtin :: * -> *) (m :: * -> *) a.
(MonadPlus m, ModInterpBuiltin modification builtin m) =>
StagedLtl modification builtin a -> m a
interpStagedLtl StagedMockChain a
act) (StagedMockChain a -> InterpMockChain a
forall a.
StagedLtl MockChainTweak MockChainBuiltin a -> MockChainT [] a
forall modification (builtin :: * -> *) (m :: * -> *) a.
(MonadPlus m, ModInterpBuiltin modification builtin m) =>
StagedLtl modification builtin a -> m a
interpStagedLtl (StagedMockChain a -> InterpMockChain a)
-> (MockChainError -> StagedMockChain a)
-> MockChainError
-> InterpMockChain a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainError -> StagedMockChain a
handler)

-- | Interprets the staged mockchain then runs the resulting computation with a
-- custom function. This can be used, for example, to supply a custom
-- 'Cooked.InitialDistribution.InitialDistribution' by providing
-- 'runMockChainTFromInitDist'.
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 = MockChainT [] a -> [res]
forall (m :: * -> *). Monad m => MockChainT m a -> m res
f (MockChainT [] a -> [res])
-> (StagedMockChain a -> MockChainT [] a)
-> StagedMockChain a
-> [res]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a -> MockChainT [] a
forall a.
StagedLtl MockChainTweak MockChainBuiltin a -> MockChainT [] a
forall modification (builtin :: * -> *) (m :: * -> *) a.
(MonadPlus m, ModInterpBuiltin modification builtin m) =>
StagedLtl modification builtin a -> m a
interpStagedLtl

-- | Same as 'interpretAndRunWith' but using 'runMockChainT' as the default way
-- to run the computation.
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

-- | A modal mockchain is a mockchain that allows us to use LTL modifications
-- with 'Tweak's
type MonadModalBlockChain m = (MonadBlockChain m, MonadLtl MockChainTweak m)

fromTweak :: Tweak m a -> Ltl (UntypedTweak m)
fromTweak :: forall (m :: * -> *) a. Tweak m a -> Ltl (UntypedTweak m)
fromTweak = 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

-- | Applies a 'Tweak' to every step in a trace where it is applicable,
-- branching at any such locations. The tweak must apply at least once.
somewhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
somewhere :: forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Tweak InterpMockChain b -> m a -> m a
somewhere = Ltl MockChainTweak -> m a -> m a
forall mod (m :: * -> *) a. MonadLtl mod m => Ltl mod -> m a -> m a
somewhere' (Ltl MockChainTweak -> m a -> m a)
-> (Tweak InterpMockChain b -> Ltl MockChainTweak)
-> Tweak InterpMockChain b
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak InterpMockChain b -> Ltl MockChainTweak
forall (m :: * -> *) a. Tweak m a -> Ltl (UntypedTweak m)
fromTweak

-- | Applies an Ltl modification following the same rules as `somewhere`.
somewhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
somewhere' :: forall mod (m :: * -> *) a. MonadLtl mod m => Ltl mod -> m a -> m a
somewhere' = Ltl mod -> m a -> m a
forall a. Ltl mod -> m a -> m a
forall modification (m :: * -> *) a.
MonadLtl modification m =>
Ltl modification -> m a -> m a
modifyLtl (Ltl mod -> m a -> m a)
-> (Ltl mod -> Ltl mod) -> Ltl mod -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ltl mod -> Ltl mod
forall a. Ltl a -> Ltl a
ltlEventually

-- | Applies a 'Tweak' to every transaction in a given trace. Fails if the tweak
-- fails anywhere in the trace.
everywhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
everywhere :: forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Tweak InterpMockChain b -> m a -> m a
everywhere = Ltl MockChainTweak -> m a -> m a
forall mod (m :: * -> *) a. MonadLtl mod m => Ltl mod -> m a -> m a
everywhere' (Ltl MockChainTweak -> m a -> m a)
-> (Tweak InterpMockChain b -> Ltl MockChainTweak)
-> Tweak InterpMockChain b
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak InterpMockChain b -> Ltl MockChainTweak
forall (m :: * -> *) a. Tweak m a -> Ltl (UntypedTweak m)
fromTweak

-- | Applies a Ltl modification following the sames rules as `everywhere`.
everywhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
everywhere' :: forall mod (m :: * -> *) a. MonadLtl mod m => Ltl mod -> m a -> m a
everywhere' = Ltl mod -> m a -> m a
forall a. Ltl mod -> m a -> m a
forall modification (m :: * -> *) a.
MonadLtl modification m =>
Ltl modification -> m a -> m a
modifyLtl (Ltl mod -> m a -> m a)
-> (Ltl mod -> Ltl mod) -> Ltl mod -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ltl mod -> Ltl mod
forall a. Ltl a -> Ltl a
ltlAlways

-- | Ensures a given 'Tweak' can never successfully be applied in a computation,
-- and leaves the computation unchanged.
nowhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
nowhere :: forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Tweak InterpMockChain b -> m a -> m a
nowhere = Ltl MockChainTweak -> m a -> m a
forall mod (m :: * -> *) a. MonadLtl mod m => Ltl mod -> m a -> m a
nowhere' (Ltl MockChainTweak -> m a -> m a)
-> (Tweak InterpMockChain b -> Ltl MockChainTweak)
-> Tweak InterpMockChain b
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak InterpMockChain b -> Ltl MockChainTweak
forall (m :: * -> *) a. Tweak m a -> Ltl (UntypedTweak m)
fromTweak

-- | Ensures a given Ltl modifications follow the same rules as `nowhere`.
nowhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
nowhere' :: forall mod (m :: * -> *) a. MonadLtl mod m => Ltl mod -> m a -> m a
nowhere' = Ltl mod -> m a -> m a
forall a. Ltl mod -> m a -> m a
forall modification (m :: * -> *) a.
MonadLtl modification m =>
Ltl modification -> m a -> m a
modifyLtl (Ltl mod -> m a -> m a)
-> (Ltl mod -> Ltl mod) -> Ltl mod -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ltl mod -> Ltl mod
forall a. Ltl a -> Ltl a
ltlNever

-- | Apply a given 'Tweak' at every location in a computation where it does not
-- fail, which might never occur.
whenAble :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
whenAble :: forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Tweak InterpMockChain b -> m a -> m a
whenAble = Ltl MockChainTweak -> m a -> m a
forall mod (m :: * -> *) a. MonadLtl mod m => Ltl mod -> m a -> m a
whenAble' (Ltl MockChainTweak -> m a -> m a)
-> (Tweak InterpMockChain b -> Ltl MockChainTweak)
-> Tweak InterpMockChain b
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak InterpMockChain b -> Ltl MockChainTweak
forall (m :: * -> *) a. Tweak m a -> Ltl (UntypedTweak m)
fromTweak

-- | Apply an Ltl modification following the same rules as `whenAble`.
whenAble' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
whenAble' :: forall mod (m :: * -> *) a. MonadLtl mod m => Ltl mod -> m a -> m a
whenAble' = Ltl mod -> m a -> m a
forall a. Ltl mod -> m a -> m a
forall modification (m :: * -> *) a.
MonadLtl modification m =>
Ltl modification -> m a -> m a
modifyLtl (Ltl mod -> m a -> m a)
-> (Ltl mod -> Ltl mod) -> Ltl mod -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ltl mod -> Ltl mod
forall a. Ltl a -> Ltl a
ltlWhenPossible

-- | Apply a 'Tweak' to the (0-indexed) nth transaction in a given
-- trace. Successful when this transaction exists and can be modified.
--
-- See also `Cooked.Tweak.Labels.labelled` to select transactions based on
-- labels instead of their index.
there :: (MonadModalBlockChain m) => Integer -> Tweak InterpMockChain b -> m a -> m a
there :: forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Integer -> Tweak InterpMockChain b -> m a -> m a
there Integer
n = Integer -> Ltl MockChainTweak -> m a -> m a
forall mod (m :: * -> *) a.
MonadLtl mod m =>
Integer -> Ltl mod -> m a -> m a
there' Integer
n (Ltl MockChainTweak -> m a -> m a)
-> (Tweak InterpMockChain b -> Ltl MockChainTweak)
-> Tweak InterpMockChain b
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak InterpMockChain b -> Ltl MockChainTweak
forall (m :: * -> *) a. Tweak m a -> Ltl (UntypedTweak m)
fromTweak

-- | Apply an Ltl modification following the same rules as `there`.
there' :: (MonadLtl mod m) => Integer -> Ltl mod -> m a -> m a
there' :: forall mod (m :: * -> *) a.
MonadLtl mod m =>
Integer -> Ltl mod -> m a -> m a
there' Integer
n = Ltl mod -> m a -> m a
forall a. Ltl mod -> m a -> m a
forall modification (m :: * -> *) a.
MonadLtl modification m =>
Ltl modification -> m a -> m a
modifyLtl (Ltl mod -> m a -> m a)
-> (Ltl mod -> Ltl mod) -> Ltl mod -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Ltl mod -> Ltl mod
forall a. Integer -> Ltl a -> Ltl a
ltlDelay Integer
n

-- | Apply a 'Tweak' to the next transaction in the given trace. The order of
-- arguments enables an idiom like
--
-- > do ...
-- >    endpoint arguments `withTweak` someModification
-- >    ...
--
-- where @endpoint@ builds and validates a single transaction depending on the
-- given @arguments@. Then `withTweak` says "I want to modify the transaction
-- returned by this endpoint in the following way".
withTweak :: (MonadModalBlockChain m) => m a -> Tweak InterpMockChain b -> m a
withTweak :: forall (m :: * -> *) a b.
MonadModalBlockChain m =>
m a -> Tweak InterpMockChain b -> m a
withTweak = (Tweak InterpMockChain b -> m a -> m a)
-> m a -> Tweak InterpMockChain b -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Integer -> Tweak InterpMockChain b -> m a -> m a
forall (m :: * -> *) b a.
MonadModalBlockChain m =>
Integer -> Tweak InterpMockChain b -> m a -> m a
there Integer
0)