{-# 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 (..),
    SkelContext (..),
    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',
  )
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.Conversion.ToCredential
import Cooked.Conversion.ToOutputDatum
import Cooked.Conversion.ToScriptHash
import Cooked.MockChain.UtxoState
import Cooked.Output
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.Ada 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 'MockChainT' monad
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 SkelContext TxSkel
  | -- | Logging a Skeleton as it has been adjusted by the balancing mechanism,
    -- alongside fee, and possible collateral utxos and return collateral wallet.
    MCLogAdjustedTxSkel SkelContext 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 Redeemer Api.TxOutRef Script.ScriptHash
  | -- | Logging the automatic adjusment of a min ada amount
    MCLogAdjustedTxSkelOut TxSkelOut Script.Ada

-- | Contains methods needed for 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.
  validatorFromHash :: Script.ValidatorHash -> m (Maybe (Script.Versioned Script.Validator))

  -- | 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 ()

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

-- | The main abstraction of the blockchain.
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. In 'MockChainT', this means:
  --
  -- - deletes the consumed outputs from 'mcstIndex'
  -- - adds the produced outputs to 'msctIndex'
  -- - deletes the consumed datums from 'mcstDatums'
  -- - adds the produced datums to 'mcstDatums'
  -- - adds the validators on outputs to the 'mcstValidators'.
  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

-- | Retrieve 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

-- | 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,
    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
$ do
    Datum
mDat <- Maybe Datum
mDatum
    ConcreteOutput
  (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)
-> Maybe
     (ConcreteOutput
        (OwnerType out) Datum (ValueType out) (ReferenceScriptType out))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConcreteOutput
   (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)
 -> Maybe
      (ConcreteOutput
         (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)))
-> ConcreteOutput
     (OwnerType out) Datum (ValueType out) (ReferenceScriptType out)
-> Maybe
     (ConcreteOutput
        (OwnerType out) Datum (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) {concreteOutputDatum = mDat}

-- | Like 'resolveDatum', but also tries to use 'fromBuiltinData' to extract a
-- datum of the suitable type.
resolveTypedDatum ::
  ( IsAbstractOutput out,
    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
    let Api.Datum BuiltinData
datum = 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
    a
dat <- BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
Api.fromBuiltinData BuiltinData
datum
    ConcreteOutput
  (OwnerType out) a (ValueType out) (ReferenceScriptType out)
-> Maybe
     (ConcreteOutput
        (OwnerType out) a (ValueType out) (ReferenceScriptType out))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConcreteOutput
   (OwnerType out) a (ValueType out) (ReferenceScriptType out)
 -> Maybe
      (ConcreteOutput
         (OwnerType out) a (ValueType out) (ReferenceScriptType out)))
-> ConcreteOutput
     (OwnerType out) a (ValueType out) (ReferenceScriptType out)
-> Maybe
     (ConcreteOutput
        (OwnerType out) a (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) {concreteOutputDatum = dat}

-- | Try 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
-- 'validatorFromHash' returns @Nothing@) return @Nothing@.
resolveValidator ::
  ( IsAbstractOutput out,
    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
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 (Api.ScriptHash BuiltinByteString
hash) -> do
      Maybe (Versioned Validator)
mVal <- ValidatorHash -> m (Maybe (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ValidatorHash -> m (Maybe (Versioned Validator))
validatorFromHash (BuiltinByteString -> ValidatorHash
Script.ValidatorHash BuiltinByteString
hash)
      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 Validator
val <- Maybe (Versioned Validator)
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 = val}

-- | Try 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
-- 'validatorFromHash' returns @Nothing@), this function will return @Nothing@.
resolveReferenceScript ::
  ( IsAbstractOutput out,
    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 (Api.ScriptHash BuiltinByteString
hash) <- out -> Maybe ScriptHash
forall o.
(IsAbstractOutput o, ToScriptHash (ReferenceScriptType o)) =>
o -> Maybe ScriptHash
outputReferenceScriptHash out
out = do
  Maybe (Versioned Validator)
mVal <- ValidatorHash -> m (Maybe (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ValidatorHash -> m (Maybe (Versioned Validator))
validatorFromHash (BuiltinByteString -> ValidatorHash
Script.ValidatorHash BuiltinByteString
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 Validator
val <- Maybe (Versioned Validator)
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 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

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

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

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

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

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

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

-- | Helper to convert 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
=<<)

-- | 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 (Api.ScriptHash BuiltinByteString
hash)) Maybe StakingCredential
_ -> do
            let valHash :: ValidatorHash
valHash = BuiltinByteString -> ValidatorHash
Script.ValidatorHash BuiltinByteString
hash
            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,))
              (ValidatorHash -> m (Maybe (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ValidatorHash -> m (Maybe (Versioned Validator))
validatorFromHash ValidatorHash
valHash)
          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 (Api.ScriptHash BuiltinByteString
sh) -> do
      Just Versioned Validator
val <- ValidatorHash -> m (Maybe (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ValidatorHash -> m (Maybe (Versioned Validator))
validatorFromHash (BuiltinByteString -> ValidatorHash
Script.ValidatorHash BuiltinByteString
sh)
      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
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 Validator)
refScript <- case Maybe ScriptHash
refS of
    Maybe ScriptHash
Nothing -> Maybe (Versioned Validator) -> m (Maybe (Versioned Validator))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Versioned Validator)
forall a. Maybe a
Nothing
    Just (Api.ScriptHash BuiltinByteString
sh) -> ValidatorHash -> m (Maybe (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ValidatorHash -> m (Maybe (Versioned Validator))
validatorFromHash (BuiltinByteString -> ValidatorHash
Script.ValidatorHash BuiltinByteString
sh)
  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 Validator)
-> TxSkelOut
forall o.
(Show o, Typeable o, IsTxInfoOutput o,
 IsTxSkelOutAllowedOwner (OwnerType o), ToCredential (OwnerType o),
 Typeable (OwnerType o), DatumType o ~ TxSkelOutDatum,
 ValueType o ~ TxSkelOutValue,
 ToVersionedScript (ReferenceScriptType o), Show (OwnerType o),
 Show (ReferenceScriptType o), Typeable (ReferenceScriptType o)) =>
o -> TxSkelOut
Pays (ConcreteOutput
   (Either PubKeyHash (Versioned Validator))
   TxSkelOutDatum
   TxSkelOutValue
   (Versioned Validator)
 -> TxSkelOut)
-> ConcreteOutput
     (Either PubKeyHash (Versioned Validator))
     TxSkelOutDatum
     TxSkelOutValue
     (Versioned Validator)
-> 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 '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. HasCallStack => String -> a
error String
"The time interval corresponding to a slot should be finite on both ends."

-- | 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) -> a
fst

-- | 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
  validatorFromHash :: ValidatorHash -> AsTrans t m (Maybe (Versioned Validator))
validatorFromHash = m (Maybe (Versioned Validator))
-> AsTrans t m (Maybe (Versioned Validator))
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 Validator))
 -> AsTrans t m (Maybe (Versioned Validator)))
-> (ValidatorHash -> m (Maybe (Versioned Validator)))
-> ValidatorHash
-> AsTrans t m (Maybe (Versioned Validator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatorHash -> m (Maybe (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ValidatorHash -> m (Maybe (Versioned Validator))
validatorFromHash
  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

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
  validatorFromHash :: ValidatorHash -> ListT m (Maybe (Versioned Validator))
validatorFromHash = m (Maybe (Versioned Validator))
-> ListT m (Maybe (Versioned Validator))
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 Validator))
 -> ListT m (Maybe (Versioned Validator)))
-> (ValidatorHash -> m (Maybe (Versioned Validator)))
-> ValidatorHash
-> ListT m (Maybe (Versioned Validator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatorHash -> m (Maybe (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
ValidatorHash -> m (Maybe (Versioned Validator))
validatorFromHash
  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

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