{-# LANGUAGE UndecidableInstances #-}

-- | This modules provides a specification for our blockchain monads, in three
-- layers:
--
-- 1. MonadBlockChainBalancing provides what's needing for balancing purposes
--
-- 2. MonadBlockChainWithoutValidation adds up remaining primitives without
-- transaction validation
--
-- 3. MonadBlockChain concludes with the addition of transaction validation,
-- thus modifying the internal index of outputs
--
-- In addition, you will find here many helpers functions which can be derived
-- from the core definition of our blockchain.
module Cooked.MockChain.BlockChain
  ( GenerateTxError (..),
    MockChainError (..),
    MockChainLogEntry (..),
    MonadBlockChainBalancing (..),
    MonadBlockChainWithoutValidation (..),
    MonadBlockChain (..),
    AsTrans (..),
    currentTime,
    waitNSlots,
    utxosFromCardanoTx,
    typedDatumFromTxOutRef,
    valueFromTxOutRef,
    outputDatumFromTxOutRef,
    datumFromTxOutRef,
    resolveDatum,
    resolveTypedDatum,
    resolveValidator,
    resolveReferenceScript,
    getEnclosingSlot,
    awaitEnclosingSlot,
    awaitDurationFromLowerBound,
    awaitDurationFromUpperBound,
    slotRangeBefore,
    slotRangeAfter,
    slotToTimeInterval,
    txSkelInputUtxos,
    txSkelReferenceInputUtxos,
    txSkelInputValidators,
    txSkelInputValue,
    txSkelInputDataAsHashes,
    lookupUtxos,
    validateTxSkel',
    validateTxSkel_,
    txSkelProposalsDeposit,
    govActionDeposit,
    txOutRefToTxSkelOut,
    txOutRefToTxSkelOut',
    defineM,
  )
where

import Cardano.Api qualified as Cardano
import Cardano.Api.Ledger qualified as Cardano
import Cardano.Ledger.Conway.PParams qualified as Conway
import Cardano.Node.Emulator qualified as Emulator
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Lens qualified as Lens
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Control
import Control.Monad.Writer
import Cooked.Output
import Cooked.Pretty.Hashable
import Cooked.Pretty.Plutus ()
import Cooked.Skeleton
import Cooked.Wallet
import Data.Kind
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Ledger.Index qualified as Ledger
import Ledger.Slot qualified as Ledger
import Ledger.Tx qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import ListT
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Data qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api

-- * Mockchain errors

-- | Errors that can arise during transaction generation
data GenerateTxError
  = -- | Error when translating a skeleton element to its Cardano counterpart
    ToCardanoError String Ledger.ToCardanoError
  | -- | Error when generating a Cardano transaction body
    TxBodyError String Cardano.TxBodyError
  | -- | Other generation error
    GenerateTxErrorGeneral String
  deriving (Int -> GenerateTxError -> ShowS
[GenerateTxError] -> ShowS
GenerateTxError -> String
(Int -> GenerateTxError -> ShowS)
-> (GenerateTxError -> String)
-> ([GenerateTxError] -> ShowS)
-> Show GenerateTxError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenerateTxError -> ShowS
showsPrec :: Int -> GenerateTxError -> ShowS
$cshow :: GenerateTxError -> String
show :: GenerateTxError -> String
$cshowList :: [GenerateTxError] -> ShowS
showList :: [GenerateTxError] -> ShowS
Show, GenerateTxError -> GenerateTxError -> Bool
(GenerateTxError -> GenerateTxError -> Bool)
-> (GenerateTxError -> GenerateTxError -> Bool)
-> Eq GenerateTxError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenerateTxError -> GenerateTxError -> Bool
== :: GenerateTxError -> GenerateTxError -> Bool
$c/= :: GenerateTxError -> GenerateTxError -> Bool
/= :: GenerateTxError -> GenerateTxError -> Bool
Eq)

-- | Errors that can be produced by the blockchain
data MockChainError
  = -- | Validation errors, either in Phase 1 or Phase 2
    MCEValidationError Ledger.ValidationPhase Ledger.ValidationError
  | -- | Thrown when the balancing wallet does not have enough funds
    MCEUnbalanceable Wallet Api.Value TxSkel
  | -- | Thrown when not enough collateral are provided. Built upon the fee, the
    -- percentage and the expected minimal collateral value.
    MCENoSuitableCollateral Integer Integer Api.Value
  | -- | Thrown when an error occured during transaction generation
    MCEGenerationError GenerateTxError
  | -- | Thrown when an output reference is missing from the mockchain state
    MCEUnknownOutRefError String Api.TxOutRef
  | -- | Same as 'MCEUnknownOutRefError' for validators.
    MCEUnknownValidator String Script.ValidatorHash
  | -- | Same as 'MCEUnknownOutRefError' for datums.
    MCEUnknownDatum String Api.DatumHash
  | -- | Used to provide 'MonadFail' instances.
    FailWith String
  deriving (Int -> MockChainError -> ShowS
[MockChainError] -> ShowS
MockChainError -> String
(Int -> MockChainError -> ShowS)
-> (MockChainError -> String)
-> ([MockChainError] -> ShowS)
-> Show MockChainError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MockChainError -> ShowS
showsPrec :: Int -> MockChainError -> ShowS
$cshow :: MockChainError -> String
show :: MockChainError -> String
$cshowList :: [MockChainError] -> ShowS
showList :: [MockChainError] -> ShowS
Show, MockChainError -> MockChainError -> Bool
(MockChainError -> MockChainError -> Bool)
-> (MockChainError -> MockChainError -> Bool) -> Eq MockChainError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MockChainError -> MockChainError -> Bool
== :: MockChainError -> MockChainError -> Bool
$c/= :: MockChainError -> MockChainError -> Bool
/= :: MockChainError -> MockChainError -> Bool
Eq)

-- * Mockchain logs

-- | This represents the specific events that should be logged when processing
-- transactions. If a new kind of event arises, then a new constructor should be
-- provided here.
data MockChainLogEntry
  = -- | Logging a Skeleton as it is submitted by the user.
    MCLogSubmittedTxSkel (Map Api.TxOutRef Api.TxOut) (Map Api.DatumHash TxSkelOutDatum) TxSkel
  | -- | Logging a Skeleton as it has been adjusted by the balancing mechanism,
    -- alongside fee, and possible collateral utxos and return collateral wallet.
    MCLogAdjustedTxSkel (Map Api.TxOutRef Api.TxOut) (Map Api.DatumHash TxSkelOutDatum) TxSkel Integer (Maybe (Set Api.TxOutRef, Wallet))
  | -- | Logging the appearance of a new transaction, after a skeleton has been
    -- successfully sent for validation.
    MCLogNewTx Api.TxId
  | -- | Logging the fact that utxos provided by the user for balancing have to be
    -- discarded for a specific reason.
    MCLogDiscardedUtxos Integer String
  | -- | Logging the fact that utxos provided as collaterals will not be used
    -- because the transaction does not involve scripts. There are 2 cases,
    -- depending on whether the user has provided an explicit wallet or a set of
    -- utxos to be used as collaterals.
    MCLogUnusedCollaterals (Either Wallet (Set Api.TxOutRef))
  | -- | Logging the automatic addition of a reference script
    MCLogAddedReferenceScript TxSkelRedeemer Api.TxOutRef Script.ScriptHash
  | -- | Logging the automatic adjusment of a min ada amount
    MCLogAdjustedTxSkelOut TxSkelOut Api.Lovelace

-- * Mockchain layers

-- | This is the first layer of our blockchain, which provides the minimal
-- subset of primitives required to perform balancing.
class (MonadFail m, MonadError MockChainError m) => MonadBlockChainBalancing m where
  -- | Returns the emulator parameters, including protocol parameters
  getParams :: m Emulator.Params

  -- | Returns a list of all UTxOs at a certain address.
  utxosAt :: Api.Address -> m [(Api.TxOutRef, Api.TxOut)]

  -- | Returns the datum with the given hash if present.
  datumFromHash :: Api.DatumHash -> m (Maybe Api.Datum)

  -- | Returns the full validator corresponding to hash, if that validator owns
  -- something or if it is stored in the reference script field of some UTxO.
  scriptFromHash :: Script.ScriptHash -> m (Maybe (Script.Versioned Script.Script))

  -- | Returns an output given a reference to it
  txOutByRef :: Api.TxOutRef -> m (Maybe Api.TxOut)

  -- | Logs an event that occured during a BlockChain run
  logEvent :: MockChainLogEntry -> m ()

-- | This is the second layer of our block, which provides all the other
-- blockchain primitives not needed for balancing, except transaction
-- validation. This layers is the one where
-- 'Cooked.MockChain.Tweak.Common.Tweak's are plugged to.
class (MonadBlockChainBalancing m) => MonadBlockChainWithoutValidation m where
  -- | Returns a list of all currently known outputs.
  allUtxos :: m [(Api.TxOutRef, Api.TxOut)]

  -- | Updates parameters
  setParams :: Emulator.Params -> m ()

  -- | Returns the current slot number
  currentSlot :: m Ledger.Slot

  -- | Waits until the current slot becomes greater or equal to the given slot,
  -- and returns the current slot after waiting.
  --
  -- Note that it might not wait for anything if the current slot is large
  -- enough.
  awaitSlot :: Ledger.Slot -> m Ledger.Slot

  -- | Binds a hashable quantity of type @a@ to a variable in the mockchain,
  -- while registering its alias for printing purposes.
  define :: (ToHash a) => String -> a -> m a

-- | Like 'define', but binds the result of a monadic computation instead
defineM :: (MonadBlockChainWithoutValidation m, ToHash a) => String -> m a -> m a
defineM :: forall (m :: * -> *) a.
(MonadBlockChainWithoutValidation m, ToHash a) =>
String -> m a -> m a
defineM String
name m a
comp = m a
comp m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> a -> m a
forall a. ToHash a => String -> a -> m a
forall (m :: * -> *) a.
(MonadBlockChainWithoutValidation m, ToHash a) =>
String -> a -> m a
define String
name

-- | The final layer of our blockchain, adding transaction validation to the
-- mix. This is the only primitive that actually modifies the ledger state.
class (MonadBlockChainWithoutValidation m) => MonadBlockChain m where
  -- | Generates, balances and validates a transaction from a skeleton. It
  -- returns the validated transaction and updates the state of the
  -- blockchain.
  validateTxSkel :: TxSkel -> m Ledger.CardanoTx

-- | Validates a skeleton, and retuns the ordered list of produced output
-- references
validateTxSkel' :: (MonadBlockChain m) => TxSkel -> m [Api.TxOutRef]
validateTxSkel' :: forall (m :: * -> *). MonadBlockChain m => TxSkel -> m [TxOutRef]
validateTxSkel' = (((TxOutRef, TxOut) -> TxOutRef)
-> [(TxOutRef, TxOut)] -> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
map (TxOutRef, TxOut) -> TxOutRef
forall a b. (a, b) -> a
fst ([(TxOutRef, TxOut)] -> [TxOutRef])
-> (CardanoTx -> [(TxOutRef, TxOut)]) -> CardanoTx -> [TxOutRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> [(TxOutRef, TxOut)]
utxosFromCardanoTx (CardanoTx -> [TxOutRef]) -> m CardanoTx -> m [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m CardanoTx -> m [TxOutRef])
-> (TxSkel -> m CardanoTx) -> TxSkel -> m [TxOutRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> m CardanoTx
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m CardanoTx
validateTxSkel

-- | Validates a skeleton, and erases the outputs
validateTxSkel_ :: (MonadBlockChain m) => TxSkel -> m ()
validateTxSkel_ :: forall (m :: * -> *). MonadBlockChain m => TxSkel -> m ()
validateTxSkel_ = m CardanoTx -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m CardanoTx -> m ()) -> (TxSkel -> m CardanoTx) -> TxSkel -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> m CardanoTx
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m CardanoTx
validateTxSkel

-- | Retrieves the ordered list of outputs of the given "CardanoTx".
--
-- This is useful when writing endpoints and/or traces to fetch utxos of
-- interest right from the start and avoid querying the chain for them
-- afterwards using 'allUtxos' or similar functions.
utxosFromCardanoTx :: Ledger.CardanoTx -> [(Api.TxOutRef, Api.TxOut)]
utxosFromCardanoTx :: CardanoTx -> [(TxOutRef, TxOut)]
utxosFromCardanoTx =
  ((TxOut, TxIn) -> (TxOutRef, TxOut))
-> [(TxOut, TxIn)] -> [(TxOutRef, TxOut)]
forall a b. (a -> b) -> [a] -> [b]
map
    ( \(TxOut
txOut, TxIn
txOutRef) ->
        ( TxIn -> TxOutRef
Ledger.fromCardanoTxIn TxIn
txOutRef,
          TxOut CtxTx ConwayEra -> TxOut
forall era. TxOut CtxTx era -> TxOut
Ledger.fromCardanoTxOutToPV2TxInfoTxOut (TxOut CtxTx ConwayEra -> TxOut) -> TxOut CtxTx ConwayEra -> TxOut
forall a b. (a -> b) -> a -> b
$ TxOut -> TxOut CtxTx ConwayEra
Ledger.getTxOut TxOut
txOut
        )
    )
    ([(TxOut, TxIn)] -> [(TxOutRef, TxOut)])
-> (CardanoTx -> [(TxOut, TxIn)])
-> CardanoTx
-> [(TxOutRef, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> [(TxOut, TxIn)]
Ledger.getCardanoTxOutRefs

-- * Mockchain helpers

-- | Try to resolve the datum on the output: If there's an inline datum, take
-- that; if there's a datum hash, look the corresponding datum up (with
-- 'datumFromHash'), returning @Nothing@ if it can't be found; if there's no
-- datum or hash at all, return @Nothing@.
resolveDatum ::
  ( IsAbstractOutput out,
    Script.ToOutputDatum (DatumType out),
    MonadBlockChainBalancing m
  ) =>
  out ->
  m (Maybe (ConcreteOutput (OwnerType out) Api.Datum (ValueType out) (ReferenceScriptType out)))
resolveDatum :: forall out (m :: * -> *).
(IsAbstractOutput out, ToOutputDatum (DatumType out),
 MonadBlockChainBalancing m) =>
out
-> m (Maybe
        (ConcreteOutput
           (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)))
resolveDatum out
out = do
  Maybe Datum
mDatum <- case out -> OutputDatum
forall o.
(IsAbstractOutput o, ToOutputDatum (DatumType o)) =>
o -> OutputDatum
outputOutputDatum out
out of
    Api.OutputDatumHash DatumHash
datumHash -> DatumHash -> m (Maybe Datum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
DatumHash -> m (Maybe Datum)
datumFromHash DatumHash
datumHash
    Api.OutputDatum Datum
datum -> Maybe Datum -> m (Maybe Datum)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Datum -> m (Maybe Datum)) -> Maybe Datum -> m (Maybe Datum)
forall a b. (a -> b) -> a -> b
$ Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
datum
    OutputDatum
Api.NoOutputDatum -> Maybe Datum -> m (Maybe Datum)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Datum
forall a. Maybe a
Nothing
  Maybe
  (ConcreteOutput
     (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
-> m (Maybe
        (ConcreteOutput
           (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (ConcreteOutput
      (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
 -> m (Maybe
         (ConcreteOutput
            (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))))
-> Maybe
     (ConcreteOutput
        (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
-> m (Maybe
        (ConcreteOutput
           (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)))
forall a b. (a -> b) -> a -> b
$ out
-> Datum
-> ConcreteOutput
     (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)
forall out dat.
IsAbstractOutput out =>
out
-> dat
-> ConcreteOutput
     (OwnerType out) dat (ValueType out) (ReferenceScriptType out)
setDatum out
out (Datum
 -> ConcreteOutput
      (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
-> Maybe Datum
-> Maybe
     (ConcreteOutput
        (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Datum
mDatum

-- | Like 'resolveDatum', but also tries to use 'Api.fromBuiltinData' to extract
-- a datum of the suitable type.
resolveTypedDatum ::
  ( IsAbstractOutput out,
    Script.ToOutputDatum (DatumType out),
    MonadBlockChainBalancing m,
    Api.FromData a
  ) =>
  out ->
  m (Maybe (ConcreteOutput (OwnerType out) a (ValueType out) (ReferenceScriptType out)))
resolveTypedDatum :: forall out (m :: * -> *) a.
(IsAbstractOutput out, ToOutputDatum (DatumType out),
 MonadBlockChainBalancing m, FromData a) =>
out
-> m (Maybe
        (ConcreteOutput
           (OwnerType out) a (ValueType out) (ReferenceScriptType out)))
resolveTypedDatum out
out = do
  Maybe
  (ConcreteOutput
     (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
mOut <- out
-> m (Maybe
        (ConcreteOutput
           (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)))
forall out (m :: * -> *).
(IsAbstractOutput out, ToOutputDatum (DatumType out),
 MonadBlockChainBalancing m) =>
out
-> m (Maybe
        (ConcreteOutput
           (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)))
resolveDatum out
out
  Maybe
  (ConcreteOutput
     (OwnerType out) a (ValueType out) (ReferenceScriptType out))
-> m (Maybe
        (ConcreteOutput
           (OwnerType out) a (ValueType out) (ReferenceScriptType out)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (ConcreteOutput
      (OwnerType out) a (ValueType out) (ReferenceScriptType out))
 -> m (Maybe
         (ConcreteOutput
            (OwnerType out) a (ValueType out) (ReferenceScriptType out))))
-> Maybe
     (ConcreteOutput
        (OwnerType out) a (ValueType out) (ReferenceScriptType out))
-> m (Maybe
        (ConcreteOutput
           (OwnerType out) a (ValueType out) (ReferenceScriptType out)))
forall a b. (a -> b) -> a -> b
$ do
    ConcreteOutput
  (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)
out' <- Maybe
  (ConcreteOutput
     (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
mOut
    out
-> a
-> ConcreteOutput
     (OwnerType out) a (ValueType out) (ReferenceScriptType out)
forall out dat.
IsAbstractOutput out =>
out
-> dat
-> ConcreteOutput
     (OwnerType out) dat (ValueType out) (ReferenceScriptType out)
setDatum out
out (a
 -> ConcreteOutput
      (OwnerType out) a (ValueType out) (ReferenceScriptType out))
-> Maybe a
-> Maybe
     (ConcreteOutput
        (OwnerType out) a (ValueType out) (ReferenceScriptType out))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
Api.fromBuiltinData (Datum -> BuiltinData
Api.getDatum (ConcreteOutput
  (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)
out' ConcreteOutput
  (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)
-> Optic'
     A_Lens
     NoIx
     (ConcreteOutput
        (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
     Datum
-> Datum
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (ConcreteOutput
     (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
  Datum
Lens'
  (ConcreteOutput
     (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
  (DatumType
     (ConcreteOutput
        (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)))
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL))

-- | Tries to resolve the validator that owns an output: If the output is owned by
-- a public key, or if the validator's hash is not known (i.e. if
-- 'scriptFromHash' returns @Nothing@) return @Nothing@.
resolveValidator ::
  ( IsAbstractOutput out,
    Script.ToCredential (OwnerType out),
    MonadBlockChainBalancing m
  ) =>
  out ->
  m (Maybe (ConcreteOutput (Script.Versioned Script.Validator) (DatumType out) (ValueType out) (ReferenceScriptType out)))
resolveValidator :: forall out (m :: * -> *).
(IsAbstractOutput out, ToCredential (OwnerType out),
 MonadBlockChainBalancing m) =>
out
-> m (Maybe
        (ConcreteOutput
           (Versioned Validator)
           (DatumType out)
           (ValueType out)
           (ReferenceScriptType out)))
resolveValidator out
out =
  case OwnerType out -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential (out
out out -> Optic' A_Lens NoIx out (OwnerType out) -> OwnerType out
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx out (OwnerType out)
forall o. IsAbstractOutput o => Lens' o (OwnerType o)
outputOwnerL) of
    Api.PubKeyCredential PubKeyHash
_ -> Maybe
  (ConcreteOutput
     (Versioned Validator)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out))
-> m (Maybe
        (ConcreteOutput
           (Versioned Validator)
           (DatumType out)
           (ValueType out)
           (ReferenceScriptType out)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (ConcreteOutput
     (Versioned Validator)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out))
forall a. Maybe a
Nothing
    Api.ScriptCredential ScriptHash
scriptHash -> do
      Maybe (Versioned Script)
mVal <- ScriptHash -> m (Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ScriptHash -> m (Maybe (Versioned Script))
scriptFromHash ScriptHash
scriptHash
      Maybe
  (ConcreteOutput
     (Versioned Validator)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out))
-> m (Maybe
        (ConcreteOutput
           (Versioned Validator)
           (DatumType out)
           (ValueType out)
           (ReferenceScriptType out)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (ConcreteOutput
      (Versioned Validator)
      (DatumType out)
      (ValueType out)
      (ReferenceScriptType out))
 -> m (Maybe
         (ConcreteOutput
            (Versioned Validator)
            (DatumType out)
            (ValueType out)
            (ReferenceScriptType out))))
-> Maybe
     (ConcreteOutput
        (Versioned Validator)
        (DatumType out)
        (ValueType out)
        (ReferenceScriptType out))
-> m (Maybe
        (ConcreteOutput
           (Versioned Validator)
           (DatumType out)
           (ValueType out)
           (ReferenceScriptType out)))
forall a b. (a -> b) -> a -> b
$ do
        Versioned Script
val <- Maybe (Versioned Script)
mVal
        ConcreteOutput
  (Versioned Validator)
  (DatumType out)
  (ValueType out)
  (ReferenceScriptType out)
-> Maybe
     (ConcreteOutput
        (Versioned Validator)
        (DatumType out)
        (ValueType out)
        (ReferenceScriptType out))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConcreteOutput
   (Versioned Validator)
   (DatumType out)
   (ValueType out)
   (ReferenceScriptType out)
 -> Maybe
      (ConcreteOutput
         (Versioned Validator)
         (DatumType out)
         (ValueType out)
         (ReferenceScriptType out)))
-> ConcreteOutput
     (Versioned Validator)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
-> Maybe
     (ConcreteOutput
        (Versioned Validator)
        (DatumType out)
        (ValueType out)
        (ReferenceScriptType out))
forall a b. (a -> b) -> a -> b
$ (out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput out
out) {concreteOutputOwner = Script.toVersioned val}

-- | Tries to resolve the reference script on an output: If the output has no
-- reference script, or if the reference script's hash is not known (i.e. if
-- 'scriptFromHash' returns 'Nothing'), this function will return 'Nothing'.
resolveReferenceScript ::
  ( IsAbstractOutput out,
    Script.ToScriptHash (ReferenceScriptType out),
    MonadBlockChainBalancing m
  ) =>
  out ->
  m (Maybe (ConcreteOutput (OwnerType out) (DatumType out) (ValueType out) (Script.Versioned Script.Validator)))
resolveReferenceScript :: forall out (m :: * -> *).
(IsAbstractOutput out, ToScriptHash (ReferenceScriptType out),
 MonadBlockChainBalancing m) =>
out
-> m (Maybe
        (ConcreteOutput
           (OwnerType out)
           (DatumType out)
           (ValueType out)
           (Versioned Validator)))
resolveReferenceScript out
out | Just ScriptHash
hash <- out -> Maybe ScriptHash
forall o.
(IsAbstractOutput o, ToScriptHash (ReferenceScriptType o)) =>
o -> Maybe ScriptHash
outputReferenceScriptHash out
out = do
  Maybe (Versioned Script)
mVal <- ScriptHash -> m (Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ScriptHash -> m (Maybe (Versioned Script))
scriptFromHash ScriptHash
hash
  Maybe
  (ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (Versioned Validator))
-> m (Maybe
        (ConcreteOutput
           (OwnerType out)
           (DatumType out)
           (ValueType out)
           (Versioned Validator)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (ConcreteOutput
      (OwnerType out)
      (DatumType out)
      (ValueType out)
      (Versioned Validator))
 -> m (Maybe
         (ConcreteOutput
            (OwnerType out)
            (DatumType out)
            (ValueType out)
            (Versioned Validator))))
-> Maybe
     (ConcreteOutput
        (OwnerType out)
        (DatumType out)
        (ValueType out)
        (Versioned Validator))
-> m (Maybe
        (ConcreteOutput
           (OwnerType out)
           (DatumType out)
           (ValueType out)
           (Versioned Validator)))
forall a b. (a -> b) -> a -> b
$ do
    Versioned Script
val <- Maybe (Versioned Script)
mVal
    ConcreteOutput
  (OwnerType out)
  (DatumType out)
  (ValueType out)
  (Versioned Validator)
-> Maybe
     (ConcreteOutput
        (OwnerType out)
        (DatumType out)
        (ValueType out)
        (Versioned Validator))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConcreteOutput
   (OwnerType out)
   (DatumType out)
   (ValueType out)
   (Versioned Validator)
 -> Maybe
      (ConcreteOutput
         (OwnerType out)
         (DatumType out)
         (ValueType out)
         (Versioned Validator)))
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (Versioned Validator)
-> Maybe
     (ConcreteOutput
        (OwnerType out)
        (DatumType out)
        (ValueType out)
        (Versioned Validator))
forall a b. (a -> b) -> a -> b
$ (out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput out
out) {concreteOutputReferenceScript = Just $ Script.toVersioned val}
resolveReferenceScript out
_ = Maybe
  (ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (Versioned Validator))
-> m (Maybe
        (ConcreteOutput
           (OwnerType out)
           (DatumType out)
           (ValueType out)
           (Versioned Validator)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (Versioned Validator))
forall a. Maybe a
Nothing

-- | Extracts a potential 'Api.OutputDatum' from a given 'Api.TxOutRef'
outputDatumFromTxOutRef :: (MonadBlockChainBalancing m) => Api.TxOutRef -> m (Maybe Api.OutputDatum)
outputDatumFromTxOutRef :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe OutputDatum)
outputDatumFromTxOutRef = ((TxOut -> OutputDatum
forall o.
(IsAbstractOutput o, ToOutputDatum (DatumType o)) =>
o -> OutputDatum
outputOutputDatum (TxOut -> OutputDatum) -> Maybe TxOut -> Maybe OutputDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe TxOut -> Maybe OutputDatum)
-> m (Maybe TxOut) -> m (Maybe OutputDatum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (Maybe TxOut) -> m (Maybe OutputDatum))
-> (TxOutRef -> m (Maybe TxOut))
-> TxOutRef
-> m (Maybe OutputDatum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> m (Maybe TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxOut)
txOutByRef

-- | Extracts a potential 'Api.Datum' from a given 'Api.TxOutRef'
datumFromTxOutRef :: (MonadBlockChainBalancing m) => Api.TxOutRef -> m (Maybe Api.Datum)
datumFromTxOutRef :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe Datum)
datumFromTxOutRef TxOutRef
oref = do
  Maybe OutputDatum
mOutputDatum <- TxOutRef -> m (Maybe OutputDatum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe OutputDatum)
outputDatumFromTxOutRef TxOutRef
oref
  case Maybe OutputDatum
mOutputDatum of
    Maybe OutputDatum
Nothing -> Maybe Datum -> m (Maybe Datum)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Datum
forall a. Maybe a
Nothing
    Just OutputDatum
Api.NoOutputDatum -> Maybe Datum -> m (Maybe Datum)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Datum
forall a. Maybe a
Nothing
    Just (Api.OutputDatum Datum
datum) -> Maybe Datum -> m (Maybe Datum)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Datum -> m (Maybe Datum)) -> Maybe Datum -> m (Maybe Datum)
forall a b. (a -> b) -> a -> b
$ Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
datum
    Just (Api.OutputDatumHash DatumHash
datumHash) -> DatumHash -> m (Maybe Datum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
DatumHash -> m (Maybe Datum)
datumFromHash DatumHash
datumHash

-- | Like 'datumFromTxOutRef', but uses 'Api.fromBuiltinData' to attempt to
-- deserialize this datum into a given type
typedDatumFromTxOutRef :: (Api.FromData a, MonadBlockChainBalancing m) => Api.TxOutRef -> m (Maybe a)
typedDatumFromTxOutRef :: forall a (m :: * -> *).
(FromData a, MonadBlockChainBalancing m) =>
TxOutRef -> m (Maybe a)
typedDatumFromTxOutRef = ((Maybe Datum -> (Datum -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(Api.Datum BuiltinData
datum) -> BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
Api.fromBuiltinData BuiltinData
datum)) (Maybe Datum -> Maybe a) -> m (Maybe Datum) -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (Maybe Datum) -> m (Maybe a))
-> (TxOutRef -> m (Maybe Datum)) -> TxOutRef -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> m (Maybe Datum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe Datum)
datumFromTxOutRef

-- | Resolves an 'Api.TxOutRef' and extracts the value it contains
valueFromTxOutRef :: (MonadBlockChainBalancing m) => Api.TxOutRef -> m (Maybe Api.Value)
valueFromTxOutRef :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe Value)
valueFromTxOutRef = ((TxOut -> Value
forall o. (IsAbstractOutput o, ToValue (ValueType o)) => o -> Value
outputValue (TxOut -> Value) -> Maybe TxOut -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe TxOut -> Maybe Value) -> m (Maybe TxOut) -> m (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (Maybe TxOut) -> m (Maybe Value))
-> (TxOutRef -> m (Maybe TxOut)) -> TxOutRef -> m (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> m (Maybe TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxOut)
txOutByRef

-- | Resolves all the inputs of a given 'Cooked.Skeleton.TxSkel'
txSkelInputUtxos :: (MonadBlockChainBalancing m) => TxSkel -> m (Map Api.TxOutRef Api.TxOut)
txSkelInputUtxos :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map TxOutRef TxOut)
txSkelInputUtxos = [TxOutRef] -> m (Map TxOutRef TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> m (Map TxOutRef TxOut)
lookupUtxos ([TxOutRef] -> m (Map TxOutRef TxOut))
-> (TxSkel -> [TxOutRef]) -> TxSkel -> m (Map TxOutRef TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef TxSkelRedeemer -> [TxOutRef]
forall k a. Map k a -> [k]
Map.keys (Map TxOutRef TxSkelRedeemer -> [TxOutRef])
-> (TxSkel -> Map TxOutRef TxSkelRedeemer) -> TxSkel -> [TxOutRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelIns

-- | Resolves all the reference inputs of a given 'Cooked.Skeleton.TxSkel'
txSkelReferenceInputUtxos :: (MonadBlockChainBalancing m) => TxSkel -> m (Map Api.TxOutRef Api.TxOut)
txSkelReferenceInputUtxos :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map TxOutRef TxOut)
txSkelReferenceInputUtxos = [TxOutRef] -> m (Map TxOutRef TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> m (Map TxOutRef TxOut)
lookupUtxos ([TxOutRef] -> m (Map TxOutRef TxOut))
-> (TxSkel -> [TxOutRef]) -> TxSkel -> m (Map TxOutRef TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> [TxOutRef]
txSkelReferenceTxOutRefs

-- | Retrieves the required deposit amount for issuing governance actions.
govActionDeposit :: (MonadBlockChainBalancing m) => m Api.Lovelace
govActionDeposit :: forall (m :: * -> *). MonadBlockChainBalancing m => m Lovelace
govActionDeposit = Integer -> Lovelace
Api.Lovelace (Integer -> Lovelace) -> (Params -> Integer) -> Params -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Integer
Cardano.unCoin (Coin -> Integer) -> (Params -> Coin) -> Params -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Coin (PParams EmulatorEra) Coin
-> PParams EmulatorEra -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting Coin (PParams EmulatorEra) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams EmulatorEra) Coin
Conway.ppGovActionDepositL (PParams EmulatorEra -> Coin)
-> (Params -> PParams EmulatorEra) -> Params -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> PParams EmulatorEra
Emulator.emulatorPParams (Params -> Lovelace) -> m Params -> m Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams

-- | Retrieves the total amount of lovelace deposited in proposals in this
-- skeleton (equal to `govActionDeposit` times the number of proposals).
txSkelProposalsDeposit :: (MonadBlockChainBalancing m) => TxSkel -> m Api.Lovelace
txSkelProposalsDeposit :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m Lovelace
txSkelProposalsDeposit TxSkel {[Wallet]
[TxSkelProposal]
[TxSkelOut]
Set TxOutRef
Set TxLabel
TxSkelWithdrawals
Map TxOutRef TxSkelRedeemer
TxSkelMints
SlotRange
TxOpts
txSkelIns :: TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelLabel :: Set TxLabel
txSkelOpts :: TxOpts
txSkelMints :: TxSkelMints
txSkelSigners :: [Wallet]
txSkelValidityRange :: SlotRange
txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelInsReference :: Set TxOutRef
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: TxSkelWithdrawals
txSkelLabel :: TxSkel -> Set TxLabel
txSkelOpts :: TxSkel -> TxOpts
txSkelMints :: TxSkel -> TxSkelMints
txSkelSigners :: TxSkel -> [Wallet]
txSkelValidityRange :: TxSkel -> SlotRange
txSkelInsReference :: TxSkel -> Set TxOutRef
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelWithdrawals :: TxSkel -> TxSkelWithdrawals
..} = Integer -> Lovelace
Api.Lovelace (Integer -> Lovelace)
-> (Lovelace -> Integer) -> Lovelace -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([TxSkelProposal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxSkelProposal]
txSkelProposals) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*) (Integer -> Integer)
-> (Lovelace -> Integer) -> Lovelace -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Integer
Api.getLovelace (Lovelace -> Lovelace) -> m Lovelace -> m Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Lovelace
forall (m :: * -> *). MonadBlockChainBalancing m => m Lovelace
govActionDeposit

-- | Converts 'Nothing' to an error
maybeErrM :: (MonadBlockChainBalancing m) => MockChainError -> (a -> b) -> m (Maybe a) -> m b
maybeErrM :: forall (m :: * -> *) a b.
MonadBlockChainBalancing m =>
MockChainError -> (a -> b) -> m (Maybe a) -> m b
maybeErrM MockChainError
err a -> b
f = (m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MockChainError -> m b
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MockChainError
err) (b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (Maybe a -> m b) -> m (Maybe a) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

-- | Returns all validators which protect transaction inputs
txSkelInputValidators :: (MonadBlockChainBalancing m) => TxSkel -> m (Map Script.ValidatorHash (Script.Versioned Script.Validator))
txSkelInputValidators :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map ValidatorHash (Versioned Validator))
txSkelInputValidators TxSkel
skel = do
  [(TxOutRef, TxOut)]
utxos <- Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef TxOut -> [(TxOutRef, TxOut)])
-> m (Map TxOutRef TxOut) -> m [(TxOutRef, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef] -> m (Map TxOutRef TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> m (Map TxOutRef TxOut)
lookupUtxos (Map TxOutRef TxSkelRedeemer -> [TxOutRef]
forall k a. Map k a -> [k]
Map.keys (Map TxOutRef TxSkelRedeemer -> [TxOutRef])
-> (TxSkel -> Map TxOutRef TxSkelRedeemer) -> TxSkel -> [TxOutRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelIns (TxSkel -> [TxOutRef]) -> TxSkel -> [TxOutRef]
forall a b. (a -> b) -> a -> b
$ TxSkel
skel)
  [(ValidatorHash, Versioned Validator)]
-> Map ValidatorHash (Versioned Validator)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ValidatorHash, Versioned Validator)]
 -> Map ValidatorHash (Versioned Validator))
-> ([Maybe (ValidatorHash, Versioned Validator)]
    -> [(ValidatorHash, Versioned Validator)])
-> [Maybe (ValidatorHash, Versioned Validator)]
-> Map ValidatorHash (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (ValidatorHash, Versioned Validator)]
-> [(ValidatorHash, Versioned Validator)]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe (ValidatorHash, Versioned Validator)]
 -> Map ValidatorHash (Versioned Validator))
-> m [Maybe (ValidatorHash, Versioned Validator)]
-> m (Map ValidatorHash (Versioned Validator))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TxOutRef, TxOut)
 -> m (Maybe (ValidatorHash, Versioned Validator)))
-> [(TxOutRef, TxOut)]
-> m [Maybe (ValidatorHash, Versioned Validator)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
      ( \(TxOutRef
_oref, TxOut
out) -> case TxOut -> Address
forall o.
(IsAbstractOutput o, ToCredential (OwnerType o)) =>
o -> Address
outputAddress TxOut
out of
          Api.Address (Api.ScriptCredential ScriptHash
sHash) Maybe StakingCredential
_ -> do
            let valHash :: ValidatorHash
valHash = ScriptHash -> ValidatorHash
forall a. ToValidatorHash a => a -> ValidatorHash
Script.toValidatorHash ScriptHash
sHash
            MockChainError
-> (Versioned Validator
    -> Maybe (ValidatorHash, Versioned Validator))
-> m (Maybe (Versioned Validator))
-> m (Maybe (ValidatorHash, Versioned Validator))
forall (m :: * -> *) a b.
MonadBlockChainBalancing m =>
MockChainError -> (a -> b) -> m (Maybe a) -> m b
maybeErrM
              ( String -> ValidatorHash -> MockChainError
MCEUnknownValidator
                  String
"txSkelInputValidators: unknown validator hash on transaction input"
                  ValidatorHash
valHash
              )
              ((ValidatorHash, Versioned Validator)
-> Maybe (ValidatorHash, Versioned Validator)
forall a. a -> Maybe a
Just ((ValidatorHash, Versioned Validator)
 -> Maybe (ValidatorHash, Versioned Validator))
-> (Versioned Validator -> (ValidatorHash, Versioned Validator))
-> Versioned Validator
-> Maybe (ValidatorHash, Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidatorHash
valHash,))
              ((Versioned Script -> Versioned Validator)
-> Maybe (Versioned Script) -> Maybe (Versioned Validator)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioned Script -> Versioned Validator
forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned (Maybe (Versioned Script) -> Maybe (Versioned Validator))
-> m (Maybe (Versioned Script)) -> m (Maybe (Versioned Validator))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash -> m (Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ScriptHash -> m (Maybe (Versioned Script))
scriptFromHash ScriptHash
sHash)
          Address
_ -> Maybe (ValidatorHash, Versioned Validator)
-> m (Maybe (ValidatorHash, Versioned Validator))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ValidatorHash, Versioned Validator)
forall a. Maybe a
Nothing
      )
      [(TxOutRef, TxOut)]
utxos

-- | Go through all of the 'Api.TxOutRef's in the list and look them up in the
-- state of the blockchain, throwing an error if one of them cannot be resolved.
lookupUtxos :: (MonadBlockChainBalancing m) => [Api.TxOutRef] -> m (Map Api.TxOutRef Api.TxOut)
lookupUtxos :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> m (Map TxOutRef TxOut)
lookupUtxos =
  ([(TxOutRef, TxOut)] -> Map TxOutRef TxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, TxOut)] -> Map TxOutRef TxOut)
-> m [(TxOutRef, TxOut)] -> m (Map TxOutRef TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
    (m [(TxOutRef, TxOut)] -> m (Map TxOutRef TxOut))
-> ([TxOutRef] -> m [(TxOutRef, TxOut)])
-> [TxOutRef]
-> m (Map TxOutRef TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef -> m (TxOutRef, TxOut))
-> [TxOutRef] -> m [(TxOutRef, TxOut)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\TxOutRef
oRef -> (TxOutRef
oRef,) (TxOut -> (TxOutRef, TxOut)) -> m TxOut -> m (TxOutRef, TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockChainError -> (TxOut -> TxOut) -> m (Maybe TxOut) -> m TxOut
forall (m :: * -> *) a b.
MonadBlockChainBalancing m =>
MockChainError -> (a -> b) -> m (Maybe a) -> m b
maybeErrM (String -> TxOutRef -> MockChainError
MCEUnknownOutRefError String
"lookupUtxos: unknown TxOutRef" TxOutRef
oRef) TxOut -> TxOut
forall a. a -> a
id (TxOutRef -> m (Maybe TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxOut)
txOutByRef TxOutRef
oRef))

-- | look up the UTxOs the transaction consumes, and sum their values.
txSkelInputValue :: (MonadBlockChainBalancing m) => TxSkel -> m Api.Value
txSkelInputValue :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m Value
txSkelInputValue = ((TxOut -> Value) -> Map TxOutRef TxOut -> Value
forall m a. Monoid m => (a -> m) -> Map TxOutRef a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Value
Api.txOutValue (Map TxOutRef TxOut -> Value) -> m (Map TxOutRef TxOut) -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (Map TxOutRef TxOut) -> m Value)
-> (TxSkel -> m (Map TxOutRef TxOut)) -> TxSkel -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> m (Map TxOutRef TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map TxOutRef TxOut)
txSkelInputUtxos

-- | Looks up the data on UTxOs the transaction consumes and returns their
-- hashes.
txSkelInputDataAsHashes :: (MonadBlockChainBalancing m) => TxSkel -> m [Api.DatumHash]
txSkelInputDataAsHashes :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m [DatumHash]
txSkelInputDataAsHashes TxSkel
skel = do
  let outputToDatumHash :: s -> Maybe DatumHash
outputToDatumHash s
output = case s
output s -> Optic' A_Lens NoIx s OutputDatum -> OutputDatum
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx s OutputDatum
Lens' s (DatumType s)
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL of
        Api.OutputDatumHash DatumHash
dHash -> DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just DatumHash
dHash
        Api.OutputDatum Datum
datum -> DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just (DatumHash -> Maybe DatumHash) -> DatumHash -> Maybe DatumHash
forall a b. (a -> b) -> a -> b
$ Datum -> DatumHash
Script.datumHash Datum
datum
        OutputDatum
Api.NoOutputDatum -> Maybe DatumHash
forall a. Maybe a
Nothing
  (Map TxOutRef TxOut -> [TxOut]
forall k a. Map k a -> [a]
Map.elems -> [TxOut]
inputTxOuts) <- TxSkel -> m (Map TxOutRef TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map TxOutRef TxOut)
txSkelInputUtxos TxSkel
skel
  [DatumHash] -> m [DatumHash]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DatumHash] -> m [DatumHash]) -> [DatumHash] -> m [DatumHash]
forall a b. (a -> b) -> a -> b
$ (TxOut -> Maybe DatumHash) -> [TxOut] -> [DatumHash]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxOut -> Maybe DatumHash
forall {s}.
(DatumType s ~ OutputDatum, IsAbstractOutput s) =>
s -> Maybe DatumHash
outputToDatumHash [TxOut]
inputTxOuts

-- | This creates a payment from an existing UTXO
txOutRefToTxSkelOut ::
  (MonadBlockChainBalancing m) =>
  -- | The UTXO to translate
  Api.TxOutRef ->
  -- | Whether to include the datum in the transaction
  Bool ->
  -- | Whether to allow further adjustment of the Ada value
  Bool ->
  m TxSkelOut
txOutRefToTxSkelOut :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> Bool -> Bool -> m TxSkelOut
txOutRefToTxSkelOut TxOutRef
oRef Bool
includeInTransactionBody Bool
allowAdaAdjustment = do
  Just txOut :: TxOut
txOut@(Api.TxOut (Api.Address Credential
cred Maybe StakingCredential
_) Value
value OutputDatum
dat Maybe ScriptHash
refS) <- TxOutRef -> m (Maybe TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxOut)
txOutByRef TxOutRef
oRef
  Either PubKeyHash (Versioned Validator)
target <- case Credential
cred of
    Api.PubKeyCredential PubKeyHash
pkh -> Either PubKeyHash (Versioned Validator)
-> m (Either PubKeyHash (Versioned Validator))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubKeyHash (Versioned Validator)
 -> m (Either PubKeyHash (Versioned Validator)))
-> Either PubKeyHash (Versioned Validator)
-> m (Either PubKeyHash (Versioned Validator))
forall a b. (a -> b) -> a -> b
$ PubKeyHash -> Either PubKeyHash (Versioned Validator)
forall a b. a -> Either a b
Left PubKeyHash
pkh
    Api.ScriptCredential ScriptHash
hash -> do
      Just Versioned Script
val <- ScriptHash -> m (Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ScriptHash -> m (Maybe (Versioned Script))
scriptFromHash ScriptHash
hash
      Either PubKeyHash (Versioned Validator)
-> m (Either PubKeyHash (Versioned Validator))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubKeyHash (Versioned Validator)
 -> m (Either PubKeyHash (Versioned Validator)))
-> Either PubKeyHash (Versioned Validator)
-> m (Either PubKeyHash (Versioned Validator))
forall a b. (a -> b) -> a -> b
$ Versioned Validator -> Either PubKeyHash (Versioned Validator)
forall a b. b -> Either a b
Right (Versioned Validator -> Either PubKeyHash (Versioned Validator))
-> Versioned Validator -> Either PubKeyHash (Versioned Validator)
forall a b. (a -> b) -> a -> b
$ forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned @Script.Validator Versioned Script
val
  TxSkelOutDatum
datum <- case OutputDatum
dat of
    OutputDatum
Api.NoOutputDatum -> TxSkelOutDatum -> m TxSkelOutDatum
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOutDatum
TxSkelOutNoDatum
    Api.OutputDatumHash DatumHash
hash -> do
      Just (Api.Datum BuiltinData
dat') <- DatumHash -> m (Maybe Datum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
DatumHash -> m (Maybe Datum)
datumFromHash DatumHash
hash
      TxSkelOutDatum -> m TxSkelOutDatum
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkelOutDatum -> m TxSkelOutDatum)
-> TxSkelOutDatum -> m TxSkelOutDatum
forall a b. (a -> b) -> a -> b
$ (if Bool
includeInTransactionBody then BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatum else BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash) BuiltinData
dat'
    Api.OutputDatum (Api.Datum BuiltinData
dat') -> TxSkelOutDatum -> m TxSkelOutDatum
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkelOutDatum -> m TxSkelOutDatum)
-> TxSkelOutDatum -> m TxSkelOutDatum
forall a b. (a -> b) -> a -> b
$ BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutInlineDatum BuiltinData
dat'
  Maybe (Versioned Script)
refScript <- case Maybe ScriptHash
refS of
    Maybe ScriptHash
Nothing -> Maybe (Versioned Script) -> m (Maybe (Versioned Script))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Versioned Script)
forall a. Maybe a
Nothing
    Just ScriptHash
hash -> ScriptHash -> m (Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ScriptHash -> m (Maybe (Versioned Script))
scriptFromHash ScriptHash
hash
  TxSkelOut -> m TxSkelOut
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkelOut -> m TxSkelOut) -> TxSkelOut -> m TxSkelOut
forall a b. (a -> b) -> a -> b
$
    ConcreteOutput
  (Either PubKeyHash (Versioned Validator))
  TxSkelOutDatum
  TxSkelOutValue
  (Versioned Script)
-> TxSkelOut
forall o.
(Show o, Typeable o, IsTxInfoOutput o,
 OwnerConstraints (OwnerType o), DatumType o ~ TxSkelOutDatum,
 ValueType o ~ TxSkelOutValue,
 ReferenceScriptConstraints (ReferenceScriptType o)) =>
o -> TxSkelOut
Pays (ConcreteOutput
   (Either PubKeyHash (Versioned Validator))
   TxSkelOutDatum
   TxSkelOutValue
   (Versioned Script)
 -> TxSkelOut)
-> ConcreteOutput
     (Either PubKeyHash (Versioned Validator))
     TxSkelOutDatum
     TxSkelOutValue
     (Versioned Script)
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$
      (TxOut
-> ConcreteOutput
     (OwnerType TxOut)
     (DatumType TxOut)
     (ValueType TxOut)
     (ReferenceScriptType TxOut)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput TxOut
txOut)
        { concreteOutputOwner = target,
          concreteOutputValue = TxSkelOutValue value allowAdaAdjustment,
          concreteOutputDatum = datum,
          concreteOutputReferenceScript = refScript
        }

-- | A default version of 'txOutRefToTxSkelOut' where we both include the datum
-- in the transaction if it was hashed in the 'Api.TxOut', and allow further ADA
-- adjustment in case changes in the output require it.
txOutRefToTxSkelOut' :: (MonadBlockChainBalancing m) => Api.TxOutRef -> m TxSkelOut
txOutRefToTxSkelOut' :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m TxSkelOut
txOutRefToTxSkelOut' TxOutRef
oRef = TxOutRef -> Bool -> Bool -> m TxSkelOut
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> Bool -> Bool -> m TxSkelOut
txOutRefToTxSkelOut TxOutRef
oRef Bool
True Bool
True

-- * Slot and Time Management

-- $slotandtime
-- #slotandtime#
--
-- Slots are integers that monotonically increase and model the passage of
-- time. By looking at the current slot, a validator gets to know that it is
-- being executed within a certain window of wall-clock time. Things can get
-- annoying pretty fast when trying to mock traces and trying to exercise
-- certain branches of certain validators; make sure you also read the docs on
-- 'autoSlotIncrease' to be able to simulate sending transactions in parallel.

-- | Moves n slots fowards
waitNSlots :: (MonadBlockChainWithoutValidation m) => Integer -> m Ledger.Slot
waitNSlots :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Integer -> m Slot
waitNSlots Integer
n =
  if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
    then String -> m Slot
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"waitNSlots: negative argument"
    else m Slot
forall (m :: * -> *). MonadBlockChainWithoutValidation m => m Slot
currentSlot m Slot -> (Slot -> m Slot) -> m Slot
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Slot -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Slot -> m Slot
awaitSlot (Slot -> m Slot) -> (Slot -> Slot) -> Slot -> m Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ Integer -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)

-- | Returns the closed ms interval corresponding to the current slot
currentTime :: (MonadBlockChainWithoutValidation m) => m (Api.POSIXTime, Api.POSIXTime)
currentTime :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m (POSIXTime, POSIXTime)
currentTime = Slot -> m (POSIXTime, POSIXTime)
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Slot -> m (POSIXTime, POSIXTime)
slotToTimeInterval (Slot -> m (POSIXTime, POSIXTime))
-> m Slot -> m (POSIXTime, POSIXTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Slot
forall (m :: * -> *). MonadBlockChainWithoutValidation m => m Slot
currentSlot

-- | Returns the closed ms interval corresponding to the slot with the given
-- number. It holds that
--
-- > slotToTimeInterval (getEnclosingSlot t) == (a, b)    ==>   a <= t <= b
--
-- and
--
-- > slotToTimeInterval n == (a, b)   ==>   getEnclosingSlot a == n && getEnclosingSlot b == n
--
-- and
--
-- > slotToTimeInterval n == (a, b)   ==>   getEnclosingSlot (a-1) == n-1 && getEnclosingSlot (b+1) == n+1
slotToTimeInterval :: (MonadBlockChainWithoutValidation m) => Ledger.Slot -> m (Api.POSIXTime, Api.POSIXTime)
slotToTimeInterval :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Slot -> m (POSIXTime, POSIXTime)
slotToTimeInterval Slot
slot = do
  SlotConfig
slotConfig <- Params -> SlotConfig
Emulator.pSlotConfig (Params -> SlotConfig) -> m Params -> m SlotConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  case SlotConfig -> Slot -> POSIXTimeRange
Emulator.slotToPOSIXTimeRange SlotConfig
slotConfig Slot
slot of
    Api.Interval
      (Api.LowerBound (Api.Finite POSIXTime
l) Bool
leftclosed)
      (Api.UpperBound (Api.Finite POSIXTime
r) Bool
rightclosed) ->
        (POSIXTime, POSIXTime) -> m (POSIXTime, POSIXTime)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( if Bool
leftclosed then POSIXTime
l else POSIXTime
l POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
1,
            if Bool
rightclosed then POSIXTime
r else POSIXTime
r POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
1
          )
    POSIXTimeRange
_ -> String -> m (POSIXTime, POSIXTime)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected unbounded slot: please report a bug at https://github.com/tweag/cooked-validators/issues"

-- | Return the slot that contains the given time. See 'slotToTimeInterval' for
-- some satisfied equational properties.
getEnclosingSlot :: (MonadBlockChainWithoutValidation m) => Api.POSIXTime -> m Ledger.Slot
getEnclosingSlot :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m Slot
getEnclosingSlot POSIXTime
t = (SlotConfig -> POSIXTime -> Slot
`Emulator.posixTimeToEnclosingSlot` POSIXTime
t) (SlotConfig -> Slot) -> (Params -> SlotConfig) -> Params -> Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> SlotConfig
Emulator.pSlotConfig (Params -> Slot) -> m Params -> m Slot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams

-- | Waits until the current slot becomes greater or equal to the slot
--  containing the given POSIX time.  Note that that it might not wait for
--  anything if the current slot is large enough.
awaitEnclosingSlot :: (MonadBlockChainWithoutValidation m) => Api.POSIXTime -> m Ledger.Slot
awaitEnclosingSlot :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m Slot
awaitEnclosingSlot = Slot -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Slot -> m Slot
awaitSlot (Slot -> m Slot) -> (POSIXTime -> m Slot) -> POSIXTime -> m Slot
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< POSIXTime -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m Slot
getEnclosingSlot

-- | Wait a given number of ms from the lower bound of the current slot and
-- returns the current slot after waiting.
awaitDurationFromLowerBound :: (MonadBlockChainWithoutValidation m) => Integer -> m Ledger.Slot
awaitDurationFromLowerBound :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Integer -> m Slot
awaitDurationFromLowerBound Integer
duration = m (POSIXTime, POSIXTime)
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m (POSIXTime, POSIXTime)
currentTime m (POSIXTime, POSIXTime)
-> ((POSIXTime, POSIXTime) -> m Slot) -> m Slot
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= POSIXTime -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m Slot
awaitEnclosingSlot (POSIXTime -> m Slot)
-> ((POSIXTime, POSIXTime) -> POSIXTime)
-> (POSIXTime, POSIXTime)
-> m Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
duration) (POSIXTime -> POSIXTime)
-> ((POSIXTime, POSIXTime) -> POSIXTime)
-> (POSIXTime, POSIXTime)
-> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime, POSIXTime) -> POSIXTime
forall a b. (a, b) -> a
fst

-- | Wait a given number of ms from the upper bound of the current slot and
-- returns the current slot after waiting.
awaitDurationFromUpperBound :: (MonadBlockChainWithoutValidation m) => Integer -> m Ledger.Slot
awaitDurationFromUpperBound :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Integer -> m Slot
awaitDurationFromUpperBound Integer
duration = m (POSIXTime, POSIXTime)
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m (POSIXTime, POSIXTime)
currentTime m (POSIXTime, POSIXTime)
-> ((POSIXTime, POSIXTime) -> m Slot) -> m Slot
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= POSIXTime -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m Slot
awaitEnclosingSlot (POSIXTime -> m Slot)
-> ((POSIXTime, POSIXTime) -> POSIXTime)
-> (POSIXTime, POSIXTime)
-> m Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
duration) (POSIXTime -> POSIXTime)
-> ((POSIXTime, POSIXTime) -> POSIXTime)
-> (POSIXTime, POSIXTime)
-> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime, POSIXTime) -> POSIXTime
forall a b. (a, b) -> b
snd

-- | The infinite range of slots ending before or at the given time
slotRangeBefore :: (MonadBlockChainWithoutValidation m) => Api.POSIXTime -> m Ledger.SlotRange
slotRangeBefore :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m SlotRange
slotRangeBefore POSIXTime
t = do
  Slot
n <- POSIXTime -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m Slot
getEnclosingSlot POSIXTime
t
  (POSIXTime
_, POSIXTime
b) <- Slot -> m (POSIXTime, POSIXTime)
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Slot -> m (POSIXTime, POSIXTime)
slotToTimeInterval Slot
n
  -- If the given time @t@ happens to be the last ms of its slot, we can include
  -- the whole slot. Otherwise, the only way to be sure that the returned slot
  -- range contains no time after @t@ is to go to the preceding slot.
  SlotRange -> m SlotRange
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotRange -> m SlotRange) -> SlotRange -> m SlotRange
forall a b. (a -> b) -> a -> b
$ Slot -> SlotRange
forall a. a -> Interval a
Api.to (Slot -> SlotRange) -> Slot -> SlotRange
forall a b. (a -> b) -> a -> b
$ if POSIXTime
t POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime
b then Slot
n else Slot
n Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
- Slot
1

-- | The infinite range of slots starting after or at the given time
slotRangeAfter :: (MonadBlockChainWithoutValidation m) => Api.POSIXTime -> m Ledger.SlotRange
slotRangeAfter :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m SlotRange
slotRangeAfter POSIXTime
t = do
  Slot
n <- POSIXTime -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
POSIXTime -> m Slot
getEnclosingSlot POSIXTime
t
  (POSIXTime
a, POSIXTime
_) <- Slot -> m (POSIXTime, POSIXTime)
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Slot -> m (POSIXTime, POSIXTime)
slotToTimeInterval Slot
n
  SlotRange -> m SlotRange
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotRange -> m SlotRange) -> SlotRange -> m SlotRange
forall a b. (a -> b) -> a -> b
$ Slot -> SlotRange
forall a. a -> Interval a
Api.from (Slot -> SlotRange) -> Slot -> SlotRange
forall a b. (a -> b) -> a -> b
$ if POSIXTime
t POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime
a then Slot
n else Slot
n Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ Slot
1

-- * Deriving further 'MonadBlockChain' instances

-- | A newtype wrapper to be used with '-XDerivingVia' to derive instances of
-- 'MonadBlockChain' for any 'MonadTransControl'.
--
-- For example, to derive 'MonadBlockChain m => MonadBlockChain (ReaderT r m)',
-- you'd write
--
-- > deriving via (AsTrans (ReaderT r) m) instance MonadBlockChain m => MonadBlockChain (ReaderT r m)
--
-- and avoid the trouble of defining all the class methods yourself.
newtype AsTrans t (m :: Type -> Type) a = AsTrans {forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (a :: k).
AsTrans t m a -> t m a
getTrans :: t m a}
  deriving newtype ((forall a b. (a -> b) -> AsTrans t m a -> AsTrans t m b)
-> (forall a b. a -> AsTrans t m b -> AsTrans t m a)
-> Functor (AsTrans t m)
forall a b. a -> AsTrans t m b -> AsTrans t m a
forall a b. (a -> b) -> AsTrans t m a -> AsTrans t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> AsTrans t m b -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> AsTrans t m a -> AsTrans t m b
$cfmap :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> AsTrans t m a -> AsTrans t m b
fmap :: forall a b. (a -> b) -> AsTrans t m a -> AsTrans t m b
$c<$ :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> AsTrans t m b -> AsTrans t m a
<$ :: forall a b. a -> AsTrans t m b -> AsTrans t m a
Functor, Functor (AsTrans t m)
Functor (AsTrans t m) =>
(forall a. a -> AsTrans t m a)
-> (forall a b.
    AsTrans t m (a -> b) -> AsTrans t m a -> AsTrans t m b)
-> (forall a b c.
    (a -> b -> c) -> AsTrans t m a -> AsTrans t m b -> AsTrans t m c)
-> (forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m b)
-> (forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m a)
-> Applicative (AsTrans t m)
forall a. a -> AsTrans t m a
forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m a
forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m b
forall a b. AsTrans t m (a -> b) -> AsTrans t m a -> AsTrans t m b
forall a b c.
(a -> b -> c) -> AsTrans t m a -> AsTrans t m b -> AsTrans t 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
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
Applicative (t m) =>
Functor (AsTrans t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (t m) =>
a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
AsTrans t m a -> AsTrans t m b -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
AsTrans t m a -> AsTrans t m b -> AsTrans t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
AsTrans t m (a -> b) -> AsTrans t m a -> AsTrans t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c) -> AsTrans t m a -> AsTrans t m b -> AsTrans t m c
$cpure :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (t m) =>
a -> AsTrans t m a
pure :: forall a. a -> AsTrans t m a
$c<*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
AsTrans t m (a -> b) -> AsTrans t m a -> AsTrans t m b
<*> :: forall a b. AsTrans t m (a -> b) -> AsTrans t m a -> AsTrans t m b
$cliftA2 :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c) -> AsTrans t m a -> AsTrans t m b -> AsTrans t m c
liftA2 :: forall a b c.
(a -> b -> c) -> AsTrans t m a -> AsTrans t m b -> AsTrans t m c
$c*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
AsTrans t m a -> AsTrans t m b -> AsTrans t m b
*> :: forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m b
$c<* :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
AsTrans t m a -> AsTrans t m b -> AsTrans t m a
<* :: forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m a
Applicative, Applicative (AsTrans t m)
Applicative (AsTrans t m) =>
(forall a b.
 AsTrans t m a -> (a -> AsTrans t m b) -> AsTrans t m b)
-> (forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m b)
-> (forall a. a -> AsTrans t m a)
-> Monad (AsTrans t m)
forall a. a -> AsTrans t m a
forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m b
forall a b. AsTrans t m a -> (a -> AsTrans t m b) -> AsTrans t m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
Monad (t m) =>
Applicative (AsTrans t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (t m) =>
a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
AsTrans t m a -> AsTrans t m b -> AsTrans t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
AsTrans t m a -> (a -> AsTrans t m b) -> AsTrans t m b
$c>>= :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
AsTrans t m a -> (a -> AsTrans t m b) -> AsTrans t m b
>>= :: forall a b. AsTrans t m a -> (a -> AsTrans t m b) -> AsTrans t m b
$c>> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
AsTrans t m a -> AsTrans t m b -> AsTrans t m b
>> :: forall a b. AsTrans t m a -> AsTrans t m b -> AsTrans t m b
$creturn :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (t m) =>
a -> AsTrans t m a
return :: forall a. a -> AsTrans t m a
Monad, (forall (m :: * -> *). Monad m => Monad (AsTrans t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a)
-> MonadTrans (AsTrans t)
forall (m :: * -> *). Monad m => Monad (AsTrans t m)
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, Monad m) =>
Monad (AsTrans t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> AsTrans t m a
lift :: forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
MonadTrans, MonadTrans (AsTrans t)
MonadTrans (AsTrans t) =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run (AsTrans t) -> m a) -> AsTrans t m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT (AsTrans t) a) -> AsTrans t m a)
-> MonadTransControl (AsTrans t)
forall (m :: * -> *) a.
Monad m =>
m (StT (AsTrans t) a) -> AsTrans t m a
forall (m :: * -> *) a.
Monad m =>
(Run (AsTrans t) -> m a) -> AsTrans t m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
forall (t :: (* -> *) -> * -> *).
MonadTransControl t =>
MonadTrans (AsTrans t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT (AsTrans t) a) -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run (AsTrans t) -> m a) -> AsTrans t m a
$cliftWith :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run (AsTrans t) -> m a) -> AsTrans t m a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (AsTrans t) -> m a) -> AsTrans t m a
$crestoreT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT (AsTrans t) a) -> AsTrans t m a
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (AsTrans t) a) -> AsTrans t m a
MonadTransControl)

instance (MonadTrans t, MonadFail m, Monad (t m)) => MonadFail (AsTrans t m) where
  fail :: forall a. String -> AsTrans t m a
fail = m a -> AsTrans t m a
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AsTrans t m a)
-> (String -> m a) -> String -> AsTrans t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

instance (MonadTransControl t, MonadError MockChainError m, Monad (t m)) => MonadError MockChainError (AsTrans t m) where
  throwError :: forall a. MockChainError -> AsTrans t m a
throwError = m a -> AsTrans t m a
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AsTrans t m a)
-> (MockChainError -> m a) -> MockChainError -> AsTrans t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainError -> m a
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a.
AsTrans t m a -> (MockChainError -> AsTrans t m a) -> AsTrans t m a
catchError AsTrans t m a
act MockChainError -> AsTrans t m a
f = (Run (AsTrans t) -> m (StT t a)) -> AsTrans t m (StT t a)
forall (m :: * -> *) a.
Monad m =>
(Run (AsTrans t) -> m a) -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (AsTrans t)
run -> m (StT t a) -> (MockChainError -> m (StT t a)) -> m (StT t a)
forall a. m a -> (MockChainError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (AsTrans t m a -> m (StT (AsTrans t) a)
Run (AsTrans t)
run AsTrans t m a
act) (AsTrans t m a -> m (StT t a)
AsTrans t m a -> m (StT (AsTrans t) a)
Run (AsTrans t)
run (AsTrans t m a -> m (StT t a))
-> (MockChainError -> AsTrans t m a)
-> MockChainError
-> m (StT t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainError -> AsTrans t m a
f)) AsTrans t m (StT t a)
-> (StT t a -> AsTrans t m a) -> AsTrans t m a
forall a b. AsTrans t m a -> (a -> AsTrans t m b) -> AsTrans t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (StT t a) -> AsTrans t m a
m (StT (AsTrans t) a) -> AsTrans t m a
forall (m :: * -> *) a.
Monad m =>
m (StT (AsTrans t) a) -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (StT t a) -> AsTrans t m a)
-> (StT t a -> m (StT t a)) -> StT t a -> AsTrans t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StT t a -> m (StT t a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance (MonadTrans t, MonadBlockChainBalancing m, Monad (t m), MonadError MockChainError (AsTrans t m)) => MonadBlockChainBalancing (AsTrans t m) where
  getParams :: AsTrans t m Params
getParams = m Params -> AsTrans t m Params
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  scriptFromHash :: ScriptHash -> AsTrans t m (Maybe (Versioned Script))
scriptFromHash = m (Maybe (Versioned Script))
-> AsTrans t m (Maybe (Versioned Script))
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Versioned Script))
 -> AsTrans t m (Maybe (Versioned Script)))
-> (ScriptHash -> m (Maybe (Versioned Script)))
-> ScriptHash
-> AsTrans t m (Maybe (Versioned Script))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> m (Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ScriptHash -> m (Maybe (Versioned Script))
scriptFromHash
  utxosAt :: Address -> AsTrans t m [(TxOutRef, TxOut)]
utxosAt = m [(TxOutRef, TxOut)] -> AsTrans t m [(TxOutRef, TxOut)]
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [(TxOutRef, TxOut)] -> AsTrans t m [(TxOutRef, TxOut)])
-> (Address -> m [(TxOutRef, TxOut)])
-> Address
-> AsTrans t m [(TxOutRef, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> m [(TxOutRef, TxOut)]
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Address -> m [(TxOutRef, TxOut)]
utxosAt
  txOutByRef :: TxOutRef -> AsTrans t m (Maybe TxOut)
txOutByRef = m (Maybe TxOut) -> AsTrans t m (Maybe TxOut)
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TxOut) -> AsTrans t m (Maybe TxOut))
-> (TxOutRef -> m (Maybe TxOut))
-> TxOutRef
-> AsTrans t m (Maybe TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> m (Maybe TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxOut)
txOutByRef
  datumFromHash :: DatumHash -> AsTrans t m (Maybe Datum)
datumFromHash = m (Maybe Datum) -> AsTrans t m (Maybe Datum)
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Datum) -> AsTrans t m (Maybe Datum))
-> (DatumHash -> m (Maybe Datum))
-> DatumHash
-> AsTrans t m (Maybe Datum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumHash -> m (Maybe Datum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
DatumHash -> m (Maybe Datum)
datumFromHash
  logEvent :: MockChainLogEntry -> AsTrans t m ()
logEvent = m () -> AsTrans t m ()
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> AsTrans t m ())
-> (MockChainLogEntry -> m ())
-> MockChainLogEntry
-> AsTrans t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent

instance (MonadTrans t, MonadBlockChainWithoutValidation m, Monad (t m), MonadError MockChainError (AsTrans t m)) => MonadBlockChainWithoutValidation (AsTrans t m) where
  allUtxos :: AsTrans t m [(TxOutRef, TxOut)]
allUtxos = m [(TxOutRef, TxOut)] -> AsTrans t m [(TxOutRef, TxOut)]
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [(TxOutRef, TxOut)]
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m [(TxOutRef, TxOut)]
allUtxos
  setParams :: Params -> AsTrans t m ()
setParams = m () -> AsTrans t m ()
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> AsTrans t m ())
-> (Params -> m ()) -> Params -> AsTrans t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> m ()
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Params -> m ()
setParams
  currentSlot :: AsTrans t m Slot
currentSlot = m Slot -> AsTrans t m Slot
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Slot
forall (m :: * -> *). MonadBlockChainWithoutValidation m => m Slot
currentSlot
  awaitSlot :: Slot -> AsTrans t m Slot
awaitSlot = m Slot -> AsTrans t m Slot
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Slot -> AsTrans t m Slot)
-> (Slot -> m Slot) -> Slot -> AsTrans t m Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Slot -> m Slot
awaitSlot
  define :: forall a. ToHash a => String -> a -> AsTrans t m a
define String
name = m a -> AsTrans t m a
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AsTrans t m a) -> (a -> m a) -> a -> AsTrans t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> m a
forall a. ToHash a => String -> a -> m a
forall (m :: * -> *) a.
(MonadBlockChainWithoutValidation m, ToHash a) =>
String -> a -> m a
define String
name

instance (MonadTrans t, MonadBlockChain m, MonadBlockChainWithoutValidation (AsTrans t m)) => MonadBlockChain (AsTrans t m) where
  validateTxSkel :: TxSkel -> AsTrans t m CardanoTx
validateTxSkel = m CardanoTx -> AsTrans t m CardanoTx
forall (m :: * -> *) a. Monad m => m a -> AsTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CardanoTx -> AsTrans t m CardanoTx)
-> (TxSkel -> m CardanoTx) -> TxSkel -> AsTrans t m CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> m CardanoTx
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m CardanoTx
validateTxSkel

deriving via (AsTrans (WriterT w) m) instance (Monoid w, MonadBlockChainBalancing m) => MonadBlockChainBalancing (WriterT w m)

deriving via (AsTrans (WriterT w) m) instance (Monoid w, MonadBlockChainWithoutValidation m) => MonadBlockChainWithoutValidation (WriterT w m)

deriving via (AsTrans (WriterT w) m) instance (Monoid w, MonadBlockChain m) => MonadBlockChain (WriterT w m)

deriving via (AsTrans (ReaderT r) m) instance (MonadBlockChainBalancing m) => MonadBlockChainBalancing (ReaderT r m)

deriving via (AsTrans (ReaderT r) m) instance (MonadBlockChainWithoutValidation m) => MonadBlockChainWithoutValidation (ReaderT r m)

deriving via (AsTrans (ReaderT r) m) instance (MonadBlockChain m) => MonadBlockChain (ReaderT r m)

deriving via (AsTrans (StateT s) m) instance (MonadBlockChainBalancing m) => MonadBlockChainBalancing (StateT s m)

deriving via (AsTrans (StateT s) m) instance (MonadBlockChainWithoutValidation m) => MonadBlockChainWithoutValidation (StateT s m)

deriving via (AsTrans (StateT s) m) instance (MonadBlockChain m) => MonadBlockChain (StateT s m)

-- 'ListT' has no 'MonadTransControl' instance, so the @deriving via ...@
-- machinery is unusable here. However, there is
--
-- > MonadError e m => MonadError e (ListT m)
--
-- so I decided to go with a bit of code duplication to implement the
-- 'MonadBlockChainWithoutValidation' and 'MonadBlockChain' instances for
-- 'ListT', instead of more black magic...

instance (MonadBlockChainBalancing m) => MonadBlockChainBalancing (ListT m) where
  getParams :: ListT m Params
getParams = m Params -> ListT m Params
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  scriptFromHash :: ScriptHash -> ListT m (Maybe (Versioned Script))
scriptFromHash = m (Maybe (Versioned Script)) -> ListT m (Maybe (Versioned Script))
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Versioned Script))
 -> ListT m (Maybe (Versioned Script)))
-> (ScriptHash -> m (Maybe (Versioned Script)))
-> ScriptHash
-> ListT m (Maybe (Versioned Script))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> m (Maybe (Versioned Script))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ScriptHash -> m (Maybe (Versioned Script))
scriptFromHash
  utxosAt :: Address -> ListT m [(TxOutRef, TxOut)]
utxosAt = m [(TxOutRef, TxOut)] -> ListT m [(TxOutRef, TxOut)]
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [(TxOutRef, TxOut)] -> ListT m [(TxOutRef, TxOut)])
-> (Address -> m [(TxOutRef, TxOut)])
-> Address
-> ListT m [(TxOutRef, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> m [(TxOutRef, TxOut)]
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Address -> m [(TxOutRef, TxOut)]
utxosAt
  txOutByRef :: TxOutRef -> ListT m (Maybe TxOut)
txOutByRef = m (Maybe TxOut) -> ListT m (Maybe TxOut)
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TxOut) -> ListT m (Maybe TxOut))
-> (TxOutRef -> m (Maybe TxOut))
-> TxOutRef
-> ListT m (Maybe TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> m (Maybe TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxOut)
txOutByRef
  datumFromHash :: DatumHash -> ListT m (Maybe Datum)
datumFromHash = m (Maybe Datum) -> ListT m (Maybe Datum)
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Datum) -> ListT m (Maybe Datum))
-> (DatumHash -> m (Maybe Datum))
-> DatumHash
-> ListT m (Maybe Datum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumHash -> m (Maybe Datum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
DatumHash -> m (Maybe Datum)
datumFromHash
  logEvent :: MockChainLogEntry -> ListT m ()
logEvent = m () -> ListT m ()
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ListT m ())
-> (MockChainLogEntry -> m ()) -> MockChainLogEntry -> ListT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent

instance (MonadBlockChainWithoutValidation m) => MonadBlockChainWithoutValidation (ListT m) where
  allUtxos :: ListT m [(TxOutRef, TxOut)]
allUtxos = m [(TxOutRef, TxOut)] -> ListT m [(TxOutRef, TxOut)]
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [(TxOutRef, TxOut)]
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m [(TxOutRef, TxOut)]
allUtxos
  setParams :: Params -> ListT m ()
setParams = m () -> ListT m ()
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ListT m ()) -> (Params -> m ()) -> Params -> ListT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> m ()
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Params -> m ()
setParams
  currentSlot :: ListT m Slot
currentSlot = m Slot -> ListT m Slot
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Slot
forall (m :: * -> *). MonadBlockChainWithoutValidation m => m Slot
currentSlot
  awaitSlot :: Slot -> ListT m Slot
awaitSlot = m Slot -> ListT m Slot
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Slot -> ListT m Slot)
-> (Slot -> m Slot) -> Slot -> ListT m Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> m Slot
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
Slot -> m Slot
awaitSlot
  define :: forall a. ToHash a => String -> a -> ListT m a
define String
name = m a -> ListT m a
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ListT m a) -> (a -> m a) -> a -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> m a
forall a. ToHash a => String -> a -> m a
forall (m :: * -> *) a.
(MonadBlockChainWithoutValidation m, ToHash a) =>
String -> a -> m a
define String
name

instance (MonadBlockChain m) => MonadBlockChain (ListT m) where
  validateTxSkel :: TxSkel -> ListT m CardanoTx
validateTxSkel = m CardanoTx -> ListT m CardanoTx
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CardanoTx -> ListT m CardanoTx)
-> (TxSkel -> m CardanoTx) -> TxSkel -> ListT m CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> m CardanoTx
forall (m :: * -> *). MonadBlockChain m => TxSkel -> m CardanoTx
validateTxSkel