{-# LANGUAGE TemplateHaskell #-}

-- | This module exposes primitives to query the current state of the
-- blockchain.
module Cooked.MockChain.Read
  ( -- * The `MockChainRead` effect
    MockChainRead,
    runMockChainRead,

    -- * Queries related to protocol parameters
    getParams,
    govActionDeposit,
    dRepDeposit,
    stakeAddressDeposit,
    stakePoolDeposit,

    -- * Queries related to `Cooked.Skeleton.TxSkel`
    txSkelDepositedValueInCertificates,
    txSkelDepositedValueInProposals,
    txSkelAllScripts,
    txSkelInputScripts,
    txSkelInputValue,

    -- * Queries related to timing
    currentSlot,
    currentMSRange,
    getEnclosingSlot,
    slotRangeBefore,
    slotRangeAfter,
    slotToMSRange,

    -- * Queries related to fetching UTxOs
    allUtxos,
    utxosAt,
    txSkelOutByRef,
    utxosFromCardanoTx,
    lookupUtxos,
    previewByRef,
    viewByRef,

    -- * Other queries
    getConstitutionScript,
    getCurrentReward,
  )
where

import Cardano.Api qualified as Cardano
import Cardano.Ledger.Conway.Core qualified as Conway
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Lens qualified as Lens
import Control.Monad
import Cooked.MockChain.Common
import Cooked.MockChain.Error
import Cooked.MockChain.GenerateTx.Credential (toStakeCredential)
import Cooked.MockChain.State
import Cooked.Skeleton
import Data.Coerce (coerce)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Ledger.Slot qualified as Ledger
import Ledger.Tx qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import Polysemy
import Polysemy.Error
import Polysemy.Fail
import Polysemy.State

-- | An effect that offers primitives to query the current state of the
-- mockchain. As its name suggests, this effect is read-only and does not alter
-- the state in any way.
data MockChainRead :: Effect where
  GetParams :: MockChainRead m Emulator.Params
  TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
  CurrentSlot :: MockChainRead m Ledger.Slot
  AllUtxos :: MockChainRead m Utxos
  UtxosAt :: (Script.ToCredential a) => a -> MockChainRead m Utxos
  GetConstitutionScript :: MockChainRead m (Maybe VScript)
  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)

makeSem_ ''MockChainRead

-- | The interpretation for read-only effect in the blockchain state
runMockChainRead ::
  forall effs a.
  ( Members
      '[ State MockChainState,
         Error Ledger.ToCardanoError,
         Error MockChainError
       ]
      effs
  ) =>
  Sem (MockChainRead : effs) a ->
  Sem effs a
runMockChainRead :: forall (effs :: EffectRow) a.
Members
  '[State MockChainState, Error ToCardanoError, Error MockChainError]
  effs =>
Sem (MockChainRead : effs) a -> Sem effs a
runMockChainRead = (forall (rInitial :: EffectRow) x.
 MockChainRead (Sem rInitial) x -> Sem effs x)
-> Sem (MockChainRead : effs) a -> Sem effs a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  MockChainRead (Sem rInitial) x -> Sem effs x)
 -> Sem (MockChainRead : effs) a -> Sem effs a)
-> (forall (rInitial :: EffectRow) x.
    MockChainRead (Sem rInitial) x -> Sem effs x)
-> Sem (MockChainRead : effs) a
-> Sem effs a
forall a b. (a -> b) -> a -> b
$ \case
  MockChainRead (Sem rInitial) x
GetParams -> (MockChainState -> x) -> Sem effs x
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets MockChainState -> x
MockChainState -> Params
mcstParams
  TxSkelOutByRef TxOutRef
oRef -> do
    Maybe (TxSkelOut, Bool)
res <- (MockChainState -> Maybe (TxSkelOut, Bool))
-> Sem effs (Maybe (TxSkelOut, Bool))
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets ((MockChainState -> Maybe (TxSkelOut, Bool))
 -> Sem effs (Maybe (TxSkelOut, Bool)))
-> (MockChainState -> Maybe (TxSkelOut, Bool))
-> Sem effs (Maybe (TxSkelOut, Bool))
forall a b. (a -> b) -> a -> b
$ TxOutRef
-> Map TxOutRef (TxSkelOut, Bool) -> Maybe (TxSkelOut, Bool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
oRef (Map TxOutRef (TxSkelOut, Bool) -> Maybe (TxSkelOut, Bool))
-> (MockChainState -> Map TxOutRef (TxSkelOut, Bool))
-> MockChainState
-> Maybe (TxSkelOut, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState -> Map TxOutRef (TxSkelOut, Bool)
mcstOutputs
    case Maybe (TxSkelOut, Bool)
res of
      Just (TxSkelOut
txSkelOut, Bool
True) -> x -> Sem effs x
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return x
TxSkelOut
txSkelOut
      Maybe (TxSkelOut, Bool)
_ -> MockChainError -> Sem effs x
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem effs x) -> MockChainError -> Sem effs x
forall a b. (a -> b) -> a -> b
$ TxOutRef -> MockChainError
MCEUnknownOutRef TxOutRef
oRef
  MockChainRead (Sem rInitial) x
AllUtxos -> (TxSkelOut -> Bool) -> Sem effs Utxos
forall {r :: EffectRow}.
Member (State MockChainState) r =>
(TxSkelOut -> Bool) -> Sem r Utxos
fetchUtxos ((TxSkelOut -> Bool) -> Sem effs Utxos)
-> (TxSkelOut -> Bool) -> Sem effs Utxos
forall a b. (a -> b) -> a -> b
$ Bool -> TxSkelOut -> Bool
forall a b. a -> b -> a
const Bool
True
  UtxosAt (a -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) -> (TxSkelOut -> Bool) -> Sem effs Utxos
forall {r :: EffectRow}.
Member (State MockChainState) r =>
(TxSkelOut -> Bool) -> Sem r Utxos
fetchUtxos ((TxSkelOut -> Bool) -> Sem effs Utxos)
-> (TxSkelOut -> Bool) -> Sem effs Utxos
forall a b. (a -> b) -> a -> b
$ (Credential -> Credential -> Bool
forall a. Eq a => a -> a -> Bool
== Credential
cred) (Credential -> Bool)
-> (TxSkelOut -> Credential) -> TxSkelOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelOut -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential
  MockChainRead (Sem rInitial) x
CurrentSlot -> (MockChainState -> x) -> Sem effs x
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets ((MockChainState -> x) -> Sem effs x)
-> (MockChainState -> x) -> Sem effs x
forall a b. (a -> b) -> a -> b
$ Optic' A_Getter NoIx MockChainState x -> MockChainState -> x
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Getter NoIx MockChainState x -> MockChainState -> x)
-> Optic' A_Getter NoIx MockChainState x -> MockChainState -> x
forall a b. (a -> b) -> a -> b
$ Lens' MockChainState EmulatedLedgerState
mcstLedgerStateL Lens' MockChainState EmulatedLedgerState
-> Optic A_Getter NoIx EmulatedLedgerState EmulatedLedgerState x x
-> Optic' A_Getter NoIx MockChainState x
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (EmulatedLedgerState -> x)
-> Optic A_Getter NoIx EmulatedLedgerState EmulatedLedgerState x x
forall s a. (s -> a) -> Getter s a
to EmulatedLedgerState -> x
forall a. Num a => EmulatedLedgerState -> a
Emulator.getSlot
  MockChainRead (Sem rInitial) x
GetConstitutionScript -> (MockChainState -> x) -> Sem effs x
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets ((MockChainState -> x) -> Sem effs x)
-> (MockChainState -> x) -> Sem effs x
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx MockChainState x -> MockChainState -> x
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx MockChainState x
Lens' MockChainState (Maybe VScript)
mcstConstitutionL
  GetCurrentReward (c -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) -> do
    Credential 'Staking
stakeCredential <- Credential -> Sem effs (Credential 'Staking)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'Staking)
toStakeCredential Credential
cred
    (MockChainState -> x) -> Sem effs x
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets ((MockChainState -> x) -> Sem effs x)
-> (MockChainState -> x) -> Sem effs x
forall a b. (a -> b) -> a -> b
$
      Optic' An_AffineFold NoIx MockChainState Lovelace
-> MockChainState -> Maybe Lovelace
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Optic' An_AffineFold NoIx MockChainState Lovelace
 -> MockChainState -> Maybe Lovelace)
-> Optic' An_AffineFold NoIx MockChainState Lovelace
-> MockChainState
-> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$
        Lens' MockChainState EmulatedLedgerState
mcstLedgerStateL
          Lens' MockChainState EmulatedLedgerState
-> Optic
     A_Getter
     NoIx
     EmulatedLedgerState
     EmulatedLedgerState
     (Maybe Coin)
     (Maybe Coin)
-> Optic
     A_Getter
     NoIx
     MockChainState
     MockChainState
     (Maybe Coin)
     (Maybe Coin)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (EmulatedLedgerState -> Maybe Coin)
-> Optic
     A_Getter
     NoIx
     EmulatedLedgerState
     EmulatedLedgerState
     (Maybe Coin)
     (Maybe Coin)
forall s a. (s -> a) -> Getter s a
to (Credential 'Staking -> EmulatedLedgerState -> Maybe Coin
Emulator.getReward Credential 'Staking
stakeCredential)
          Optic
  A_Getter
  NoIx
  MockChainState
  MockChainState
  (Maybe Coin)
  (Maybe Coin)
-> Optic A_Prism NoIx (Maybe Coin) (Maybe Coin) Coin Coin
-> Optic An_AffineFold NoIx MockChainState MockChainState Coin Coin
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx (Maybe Coin) (Maybe Coin) Coin Coin
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
          Optic An_AffineFold NoIx MockChainState MockChainState Coin Coin
-> Optic A_Getter NoIx Coin Coin Lovelace Lovelace
-> Optic' An_AffineFold NoIx MockChainState Lovelace
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Coin -> Lovelace)
-> Optic A_Getter NoIx Coin Coin Lovelace Lovelace
forall s a. (s -> a) -> Getter s a
to Coin -> Lovelace
forall a b. Coercible a b => a -> b
coerce
  where
    fetchUtxos :: (TxSkelOut -> Bool) -> Sem r Utxos
fetchUtxos TxSkelOut -> Bool
decide =
      (MockChainState -> Utxos) -> Sem r Utxos
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets ((MockChainState -> Utxos) -> Sem r Utxos)
-> (MockChainState -> Utxos) -> Sem r Utxos
forall a b. (a -> b) -> a -> b
$
        Optic' A_Fold NoIx MockChainState (TxOutRef, TxSkelOut)
-> MockChainState -> Utxos
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' A_Fold NoIx MockChainState (TxOutRef, TxSkelOut)
 -> MockChainState -> Utxos)
-> Optic' A_Fold NoIx MockChainState (TxOutRef, TxSkelOut)
-> MockChainState
-> Utxos
forall a b. (a -> b) -> a -> b
$
          Lens' MockChainState (Map TxOutRef (TxSkelOut, Bool))
mcstOutputsL
            Lens' MockChainState (Map TxOutRef (TxSkelOut, Bool))
-> Optic
     A_Getter
     NoIx
     (Map TxOutRef (TxSkelOut, Bool))
     (Map TxOutRef (TxSkelOut, Bool))
     [(TxOutRef, (TxSkelOut, Bool))]
     [(TxOutRef, (TxSkelOut, Bool))]
-> Optic
     A_Getter
     NoIx
     MockChainState
     MockChainState
     [(TxOutRef, (TxSkelOut, Bool))]
     [(TxOutRef, (TxSkelOut, Bool))]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Map TxOutRef (TxSkelOut, Bool) -> [(TxOutRef, (TxSkelOut, Bool))])
-> Optic
     A_Getter
     NoIx
     (Map TxOutRef (TxSkelOut, Bool))
     (Map TxOutRef (TxSkelOut, Bool))
     [(TxOutRef, (TxSkelOut, Bool))]
     [(TxOutRef, (TxSkelOut, Bool))]
forall s a. (s -> a) -> Getter s a
to Map TxOutRef (TxSkelOut, Bool) -> [(TxOutRef, (TxSkelOut, Bool))]
forall k a. Map k a -> [(k, a)]
Map.toList
            Optic
  A_Getter
  NoIx
  MockChainState
  MockChainState
  [(TxOutRef, (TxSkelOut, Bool))]
  [(TxOutRef, (TxSkelOut, Bool))]
-> Optic
     A_Traversal
     NoIx
     [(TxOutRef, (TxSkelOut, Bool))]
     [(TxOutRef, (TxSkelOut, Bool))]
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
-> Optic
     A_Fold
     NoIx
     MockChainState
     MockChainState
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  NoIx
  [(TxOutRef, (TxSkelOut, Bool))]
  [(TxOutRef, (TxSkelOut, Bool))]
  (TxOutRef, (TxSkelOut, Bool))
  (TxOutRef, (TxSkelOut, Bool))
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
            Optic
  A_Fold
  NoIx
  MockChainState
  MockChainState
  (TxOutRef, (TxSkelOut, Bool))
  (TxOutRef, (TxSkelOut, Bool))
-> Optic
     An_AffineFold
     NoIx
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
-> Optic
     A_Fold
     NoIx
     MockChainState
     MockChainState
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ((TxOutRef, (TxSkelOut, Bool)) -> Bool)
-> Optic
     An_AffineFold
     NoIx
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
forall a. (a -> Bool) -> AffineFold a a
filtered ((TxSkelOut, Bool) -> Bool
forall a b. (a, b) -> b
snd ((TxSkelOut, Bool) -> Bool)
-> ((TxOutRef, (TxSkelOut, Bool)) -> (TxSkelOut, Bool))
-> (TxOutRef, (TxSkelOut, Bool))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, (TxSkelOut, Bool)) -> (TxSkelOut, Bool)
forall a b. (a, b) -> b
snd)
            Optic
  A_Fold
  NoIx
  MockChainState
  MockChainState
  (TxOutRef, (TxSkelOut, Bool))
  (TxOutRef, (TxSkelOut, Bool))
-> Optic
     An_AffineFold
     NoIx
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
-> Optic
     A_Fold
     NoIx
     MockChainState
     MockChainState
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ((TxOutRef, (TxSkelOut, Bool)) -> Bool)
-> Optic
     An_AffineFold
     NoIx
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
forall a. (a -> Bool) -> AffineFold a a
filtered (TxSkelOut -> Bool
decide (TxSkelOut -> Bool)
-> ((TxOutRef, (TxSkelOut, Bool)) -> TxSkelOut)
-> (TxOutRef, (TxSkelOut, Bool))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSkelOut, Bool) -> TxSkelOut
forall a b. (a, b) -> a
fst ((TxSkelOut, Bool) -> TxSkelOut)
-> ((TxOutRef, (TxSkelOut, Bool)) -> (TxSkelOut, Bool))
-> (TxOutRef, (TxSkelOut, Bool))
-> TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, (TxSkelOut, Bool)) -> (TxSkelOut, Bool)
forall a b. (a, b) -> b
snd)
            Optic
  A_Fold
  NoIx
  MockChainState
  MockChainState
  (TxOutRef, (TxSkelOut, Bool))
  (TxOutRef, (TxSkelOut, Bool))
-> Optic
     A_Getter
     NoIx
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, TxSkelOut)
     (TxOutRef, TxSkelOut)
-> Optic' A_Fold NoIx MockChainState (TxOutRef, TxSkelOut)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ((TxOutRef, (TxSkelOut, Bool)) -> (TxOutRef, TxSkelOut))
-> Optic
     A_Getter
     NoIx
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, (TxSkelOut, Bool))
     (TxOutRef, TxSkelOut)
     (TxOutRef, TxSkelOut)
forall s a. (s -> a) -> Getter s a
to (((TxSkelOut, Bool) -> TxSkelOut)
-> (TxOutRef, (TxSkelOut, Bool)) -> (TxOutRef, TxSkelOut)
forall a b. (a -> b) -> (TxOutRef, a) -> (TxOutRef, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxSkelOut, Bool) -> TxSkelOut
forall a b. (a, b) -> a
fst)

-- | Returns the emulator parameters, including protocol parameters
getParams ::
  (Member MockChainRead effs) =>
  Sem effs Emulator.Params

-- | Retrieves the required governance action deposit amount
govActionDeposit ::
  (Member MockChainRead effs) =>
  Sem effs Api.Lovelace
govActionDeposit :: forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
govActionDeposit =
  Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
    Sem effs Params -> (Params -> Lovelace) -> Sem effs Lovelace
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> 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

-- | Retrieves the required drep deposit amount
dRepDeposit ::
  (Member MockChainRead effs) =>
  Sem effs Api.Lovelace
dRepDeposit :: forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
dRepDeposit =
  Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
    Sem effs Params -> (Params -> Lovelace) -> Sem effs Lovelace
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> 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.ppDRepDepositL
    (PParams EmulatorEra -> Coin)
-> (Params -> PParams EmulatorEra) -> Params -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> PParams EmulatorEra
Emulator.emulatorPParams

-- | Retrieves the required stake address deposit amount
stakeAddressDeposit ::
  (Member MockChainRead effs) =>
  Sem effs Api.Lovelace
stakeAddressDeposit :: forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
stakeAddressDeposit =
  Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
    Sem effs Params -> (Params -> Lovelace) -> Sem effs Lovelace
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> 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. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams EmulatorEra) Coin
Conway.ppKeyDepositL
    (PParams EmulatorEra -> Coin)
-> (Params -> PParams EmulatorEra) -> Params -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> PParams EmulatorEra
Emulator.emulatorPParams

-- | Retrieves the required stake pool deposit amount
stakePoolDeposit ::
  (Member MockChainRead effs) =>
  Sem effs Api.Lovelace
stakePoolDeposit :: forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
stakePoolDeposit =
  Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
    Sem effs Params -> (Params -> Lovelace) -> Sem effs Lovelace
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> 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. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams EmulatorEra) Coin
Conway.ppPoolDepositL
    (PParams EmulatorEra -> Coin)
-> (Params -> PParams EmulatorEra) -> Params -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> PParams EmulatorEra
Emulator.emulatorPParams

-- | Retrieves the total amount of lovelace deposited in certificates in this
-- skeleton. Note that unregistering a staking address or a dRep lead to a
-- negative deposit (a withdrawal, in fact) which means this function can return
-- a negative amount of lovelace, which is intended. The deposited amounts are
-- dictated by the current protocol parameters, and computed as such.
txSkelDepositedValueInCertificates ::
  (Member MockChainRead effs) =>
  TxSkel ->
  Sem effs Api.Lovelace
txSkelDepositedValueInCertificates :: forall (effs :: EffectRow).
Member MockChainRead effs =>
TxSkel -> Sem effs Lovelace
txSkelDepositedValueInCertificates TxSkel
txSkel = do
  Lovelace
sDep <- Sem effs Lovelace
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
stakeAddressDeposit
  Lovelace
dDep <- Sem effs Lovelace
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
dRepDeposit
  Lovelace
pDep <- Sem effs Lovelace
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
stakePoolDeposit
  Lovelace -> Sem effs Lovelace
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lovelace -> Sem effs Lovelace) -> Lovelace -> Sem effs Lovelace
forall a b. (a -> b) -> a -> b
$
    Optic' A_Fold NoIx TxSkel Lovelace -> TxSkel -> Lovelace
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf
      ( Lens' TxSkel [TxSkelCertificate]
txSkelCertificatesL
          Lens' TxSkel [TxSkelCertificate]
-> Optic
     A_Traversal
     NoIx
     [TxSkelCertificate]
     [TxSkelCertificate]
     TxSkelCertificate
     TxSkelCertificate
-> Optic
     A_Traversal NoIx TxSkel TxSkel TxSkelCertificate TxSkelCertificate
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  NoIx
  [TxSkelCertificate]
  [TxSkelCertificate]
  TxSkelCertificate
  TxSkelCertificate
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
          Optic
  A_Traversal NoIx TxSkel TxSkel TxSkelCertificate TxSkelCertificate
-> Optic
     A_Getter NoIx TxSkelCertificate TxSkelCertificate Lovelace Lovelace
-> Optic' A_Fold NoIx TxSkel Lovelace
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (TxSkelCertificate -> Lovelace)
-> Optic
     A_Getter NoIx TxSkelCertificate TxSkelCertificate Lovelace Lovelace
forall s a. (s -> a) -> Getter s a
to
            ( \case
                TxSkelCertificate User kind 'Redemption
_ StakingRegister {} -> Lovelace
sDep
                TxSkelCertificate User kind 'Redemption
_ StakingRegisterDelegate {} -> Lovelace
sDep
                TxSkelCertificate User kind 'Redemption
_ StakingUnRegister {} -> -Lovelace
sDep
                TxSkelCertificate User kind 'Redemption
_ DRepRegister {} -> Lovelace
dDep
                TxSkelCertificate User kind 'Redemption
_ DRepUnRegister {} -> -Lovelace
dDep
                TxSkelCertificate User kind 'Redemption
_ PoolRegister {} -> Lovelace
pDep
                -- There is no special case for 'PoolRetire' because the deposit
                -- is given back to the reward account.
                TxSkelCertificate
_ -> Integer -> Lovelace
Api.Lovelace Integer
0
            )
      )
      TxSkel
txSkel

-- | Retrieves the total amount of lovelace deposited in proposals in this
-- skeleton (equal to `govActionDeposit` times the number of proposals)
txSkelDepositedValueInProposals ::
  (Member MockChainRead effs) =>
  TxSkel ->
  Sem effs Api.Lovelace
txSkelDepositedValueInProposals :: forall (effs :: EffectRow).
Member MockChainRead effs =>
TxSkel -> Sem effs Lovelace
txSkelDepositedValueInProposals TxSkel {[TxSkelProposal]
txSkelProposals :: [TxSkelProposal]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelProposals} =
  Sem effs Lovelace
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
govActionDeposit
    Sem effs Lovelace -> (Lovelace -> Lovelace) -> Sem effs Lovelace
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> 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

-- | Returns all scripts involved in this 'TxSkel'
txSkelAllScripts ::
  (Member MockChainRead effs) =>
  TxSkel ->
  Sem effs [VScript]
txSkelAllScripts :: forall (effs :: EffectRow).
Member MockChainRead effs =>
TxSkel -> Sem effs [VScript]
txSkelAllScripts TxSkel
txSkel = do
  [VScript]
txSkelSpendingScripts <- TxSkel -> Sem effs [VScript]
forall (effs :: EffectRow).
Member MockChainRead effs =>
TxSkel -> Sem effs [VScript]
txSkelInputScripts TxSkel
txSkel
  [VScript] -> Sem effs [VScript]
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( TxSkel -> [VScript]
txSkelMintingScripts TxSkel
txSkel
        [VScript] -> [VScript] -> [VScript]
forall a. Semigroup a => a -> a -> a
<> TxSkel -> [VScript]
txSkelWithdrawingScripts TxSkel
txSkel
        [VScript] -> [VScript] -> [VScript]
forall a. Semigroup a => a -> a -> a
<> TxSkel -> [VScript]
txSkelProposingScripts TxSkel
txSkel
        [VScript] -> [VScript] -> [VScript]
forall a. Semigroup a => a -> a -> a
<> TxSkel -> [VScript]
txSkelCertifyingScripts TxSkel
txSkel
        [VScript] -> [VScript] -> [VScript]
forall a. Semigroup a => a -> a -> a
<> [VScript]
txSkelSpendingScripts
    )

-- | Returns all scripts which guard transaction inputs
txSkelInputScripts ::
  (Member MockChainRead effs) =>
  TxSkel ->
  Sem effs [VScript]
txSkelInputScripts :: forall (effs :: EffectRow).
Member MockChainRead effs =>
TxSkel -> Sem effs [VScript]
txSkelInputScripts =
  ([Maybe VScript] -> [VScript])
-> Sem effs [Maybe VScript] -> Sem effs [VScript]
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe VScript] -> [VScript]
forall a. [Maybe a] -> [a]
catMaybes
    (Sem effs [Maybe VScript] -> Sem effs [VScript])
-> (TxSkel -> Sem effs [Maybe VScript])
-> TxSkel
-> Sem effs [VScript]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef -> Sem effs (Maybe VScript))
-> [TxOutRef] -> Sem effs [Maybe VScript]
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 (Optic' An_AffineTraversal NoIx TxSkelOut VScript
-> TxOutRef -> Sem effs (Maybe VScript)
forall (effs :: EffectRow) af (is :: IxList) c.
(Member MockChainRead effs, Is af An_AffineFold) =>
Optic' af is TxSkelOut c -> TxOutRef -> Sem effs (Maybe c)
previewByRef (Lens' TxSkelOut (User 'IsEither 'Allocation)
txSkelOutOwnerL Lens' TxSkelOut (User 'IsEither 'Allocation)
-> Optic
     An_AffineTraversal
     NoIx
     (User 'IsEither 'Allocation)
     (User 'IsEither 'Allocation)
     VScript
     VScript
-> Optic' An_AffineTraversal NoIx TxSkelOut VScript
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_AffineTraversal
  NoIx
  (User 'IsEither 'Allocation)
  (User 'IsEither 'Allocation)
  VScript
  VScript
forall (kind :: UserKind) (mode :: UserMode).
AffineTraversal' (User kind mode) VScript
userVScriptAT))
    ([TxOutRef] -> Sem effs [Maybe VScript])
-> (TxSkel -> [TxOutRef]) -> TxSkel -> Sem effs [Maybe VScript]
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

-- | look up the UTxOs the transaction consumes, and sum their values.
txSkelInputValue ::
  (Member MockChainRead effs) =>
  TxSkel ->
  Sem effs Api.Value
txSkelInputValue :: forall (effs :: EffectRow).
Member MockChainRead effs =>
TxSkel -> Sem effs Value
txSkelInputValue =
  ([Value] -> Value) -> Sem effs [Value] -> Sem effs Value
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat
    (Sem effs [Value] -> Sem effs Value)
-> (TxSkel -> Sem effs [Value]) -> TxSkel -> Sem effs Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef -> Sem effs Value) -> [TxOutRef] -> Sem effs [Value]
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 (Optic' A_Lens NoIx TxSkelOut Value -> TxOutRef -> Sem effs Value
forall (effs :: EffectRow) g (is :: IxList) c.
(Member MockChainRead effs, Is g A_Getter) =>
Optic' g is TxSkelOut c -> TxOutRef -> Sem effs c
viewByRef Optic' A_Lens NoIx TxSkelOut Value
txSkelOutValueL)
    ([TxOutRef] -> Sem effs [Value])
-> (TxSkel -> [TxOutRef]) -> TxSkel -> Sem effs [Value]
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

-- | Returns the current slot
currentSlot ::
  (Member MockChainRead effs) =>
  Sem effs Ledger.Slot

-- | Returns the closed ms interval corresponding to the current slot
currentMSRange ::
  (Members '[MockChainRead, Fail] effs) =>
  Sem effs (Api.POSIXTime, Api.POSIXTime)
currentMSRange :: forall (effs :: EffectRow).
Members '[MockChainRead, Fail] effs =>
Sem effs (POSIXTime, POSIXTime)
currentMSRange = Slot -> Sem effs (POSIXTime, POSIXTime)
forall (effs :: EffectRow) i.
(Members '[MockChainRead, Fail] effs, Integral i) =>
i -> Sem effs (POSIXTime, POSIXTime)
slotToMSRange (Slot -> Sem effs (POSIXTime, POSIXTime))
-> Sem effs Slot -> Sem effs (POSIXTime, POSIXTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem effs Slot
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Slot
currentSlot

-- | Return the slot that contains the given time. See 'slotToMSRange' for
-- some satisfied equational properties.
getEnclosingSlot ::
  (Member MockChainRead effs) =>
  Api.POSIXTime ->
  Sem effs Ledger.Slot
getEnclosingSlot :: forall (effs :: EffectRow).
Member MockChainRead effs =>
POSIXTime -> Sem effs Slot
getEnclosingSlot POSIXTime
t =
  Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
    Sem effs Params -> (Params -> Slot) -> Sem effs Slot
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (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

-- | The infinite range of slots ending before or at the given time
slotRangeBefore ::
  (Members '[MockChainRead, Fail] effs) =>
  Api.POSIXTime ->
  Sem effs Ledger.SlotRange
slotRangeBefore :: forall (effs :: EffectRow).
Members '[MockChainRead, Fail] effs =>
POSIXTime -> Sem effs SlotRange
slotRangeBefore POSIXTime
t = do
  Slot
n <- POSIXTime -> Sem effs Slot
forall (effs :: EffectRow).
Member MockChainRead effs =>
POSIXTime -> Sem effs Slot
getEnclosingSlot POSIXTime
t
  (POSIXTime
_, POSIXTime
b) <- Slot -> Sem effs (POSIXTime, POSIXTime)
forall (effs :: EffectRow) i.
(Members '[MockChainRead, Fail] effs, Integral i) =>
i -> Sem effs (POSIXTime, POSIXTime)
slotToMSRange 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 -> Sem effs SlotRange
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotRange -> Sem effs SlotRange)
-> SlotRange -> Sem effs 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 ::
  (Members '[MockChainRead, Fail] effs) =>
  Api.POSIXTime ->
  Sem effs Ledger.SlotRange
slotRangeAfter :: forall (effs :: EffectRow).
Members '[MockChainRead, Fail] effs =>
POSIXTime -> Sem effs SlotRange
slotRangeAfter POSIXTime
t = do
  Slot
n <- POSIXTime -> Sem effs Slot
forall (effs :: EffectRow).
Member MockChainRead effs =>
POSIXTime -> Sem effs Slot
getEnclosingSlot POSIXTime
t
  (POSIXTime
a, POSIXTime
_) <- Slot -> Sem effs (POSIXTime, POSIXTime)
forall (effs :: EffectRow) i.
(Members '[MockChainRead, Fail] effs, Integral i) =>
i -> Sem effs (POSIXTime, POSIXTime)
slotToMSRange Slot
n
  SlotRange -> Sem effs SlotRange
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotRange -> Sem effs SlotRange)
-> SlotRange -> Sem effs 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

-- | Returns the closed ms interval corresponding to the slot with the given
-- number. It holds that
--
-- > slotToMSRange (getEnclosingSlot t) == (a, b)    ==>   a <= t <= b
--
-- and
--
-- > slotToMSRange n == (a, b)   ==>   getEnclosingSlot a == n && getEnclosingSlot b == n
--
-- and
--
-- > slotToMSRange n == (a, b)   ==>   getEnclosingSlot (a-1) == n-1 && getEnclosingSlot (b+1) == n+1
slotToMSRange ::
  ( Members '[MockChainRead, Fail] effs,
    Integral i
  ) =>
  i ->
  Sem effs (Api.POSIXTime, Api.POSIXTime)
slotToMSRange :: forall (effs :: EffectRow) i.
(Members '[MockChainRead, Fail] effs, Integral i) =>
i -> Sem effs (POSIXTime, POSIXTime)
slotToMSRange (i -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Slot
slot) = do
  SlotConfig
slotConfig <- Params -> SlotConfig
Emulator.pSlotConfig (Params -> SlotConfig) -> Sem effs Params -> Sem effs SlotConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs 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) -> Sem effs (POSIXTime, POSIXTime)
forall a. a -> Sem effs 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 -> Sem effs (POSIXTime, POSIXTime)
forall a. String -> Sem effs 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"

-- | Returns a list of all currently known outputs
allUtxos ::
  (Member MockChainRead effs) =>
  Sem effs Utxos

-- | Returns a list of all UTxOs at a certain address.
utxosAt ::
  ( Member MockChainRead effs,
    Script.ToCredential cred
  ) =>
  cred ->
  Sem effs Utxos

-- | Returns an output given a reference to it
txSkelOutByRef ::
  (Member MockChainRead effs) =>
  Api.TxOutRef ->
  Sem effs TxSkelOut

-- | 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 ::
  (Member MockChainRead effs) =>
  Ledger.CardanoTx ->
  Sem effs [(Api.TxOutRef, TxSkelOut)]
utxosFromCardanoTx :: forall (effs :: EffectRow).
Member MockChainRead effs =>
CardanoTx -> Sem effs Utxos
utxosFromCardanoTx =
  (TxOutRef -> Sem effs (TxOutRef, TxSkelOut))
-> [TxOutRef] -> Sem effs Utxos
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
txOutRef -> (TxOutRef
txOutRef,) (TxSkelOut -> (TxOutRef, TxSkelOut))
-> Sem effs TxSkelOut -> Sem effs (TxOutRef, TxSkelOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOutRef -> Sem effs TxSkelOut
forall (effs :: EffectRow).
Member MockChainRead effs =>
TxOutRef -> Sem effs TxSkelOut
txSkelOutByRef TxOutRef
txOutRef)
    ([TxOutRef] -> Sem effs Utxos)
-> (CardanoTx -> [TxOutRef]) -> CardanoTx -> Sem effs Utxos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxOut, TxIn) -> TxOutRef) -> [(TxOut, TxIn)] -> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxIn -> TxOutRef
Ledger.fromCardanoTxIn (TxIn -> TxOutRef)
-> ((TxOut, TxIn) -> TxIn) -> (TxOut, TxIn) -> TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut, TxIn) -> TxIn
forall a b. (a, b) -> b
snd)
    ([(TxOut, TxIn)] -> [TxOutRef])
-> (CardanoTx -> [(TxOut, TxIn)]) -> CardanoTx -> [TxOutRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> [(TxOut, TxIn)]
Ledger.getCardanoTxOutRefs

-- | 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 ::
  (Member MockChainRead effs) =>
  [Api.TxOutRef] ->
  Sem effs (Map Api.TxOutRef TxSkelOut)
lookupUtxos :: forall (effs :: EffectRow).
Member MockChainRead effs =>
[TxOutRef] -> Sem effs (Map TxOutRef TxSkelOut)
lookupUtxos =
  (Map TxOutRef TxSkelOut
 -> TxOutRef -> Sem effs (Map TxOutRef TxSkelOut))
-> Map TxOutRef TxSkelOut
-> [TxOutRef]
-> Sem effs (Map TxOutRef TxSkelOut)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
    (\Map TxOutRef TxSkelOut
m TxOutRef
oRef -> (TxSkelOut -> Map TxOutRef TxSkelOut -> Map TxOutRef TxSkelOut)
-> Map TxOutRef TxSkelOut -> TxSkelOut -> Map TxOutRef TxSkelOut
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TxOutRef
-> TxSkelOut -> Map TxOutRef TxSkelOut -> Map TxOutRef TxSkelOut
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxOutRef
oRef) Map TxOutRef TxSkelOut
m (TxSkelOut -> Map TxOutRef TxSkelOut)
-> Sem effs TxSkelOut -> Sem effs (Map TxOutRef TxSkelOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOutRef -> Sem effs TxSkelOut
forall (effs :: EffectRow).
Member MockChainRead effs =>
TxOutRef -> Sem effs TxSkelOut
txSkelOutByRef TxOutRef
oRef)
    Map TxOutRef TxSkelOut
forall k a. Map k a
Map.empty

-- | Retrieves an output and views a specific element out of it
viewByRef ::
  ( Member MockChainRead effs,
    Is g A_Getter
  ) =>
  Optic' g is TxSkelOut c ->
  Api.TxOutRef ->
  Sem effs c
viewByRef :: forall (effs :: EffectRow) g (is :: IxList) c.
(Member MockChainRead effs, Is g A_Getter) =>
Optic' g is TxSkelOut c -> TxOutRef -> Sem effs c
viewByRef Optic' g is TxSkelOut c
optic = (Optic' g is TxSkelOut c -> TxSkelOut -> c
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' g is TxSkelOut c
optic (TxSkelOut -> c) -> Sem effs TxSkelOut -> Sem effs c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Sem effs TxSkelOut -> Sem effs c)
-> (TxOutRef -> Sem effs TxSkelOut) -> TxOutRef -> Sem effs c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> Sem effs TxSkelOut
forall (effs :: EffectRow).
Member MockChainRead effs =>
TxOutRef -> Sem effs TxSkelOut
txSkelOutByRef

-- | Retrieves an output and previews a specific element out of it
previewByRef ::
  ( Member MockChainRead effs,
    Is af An_AffineFold
  ) =>
  Optic' af is TxSkelOut c ->
  Api.TxOutRef ->
  Sem effs (Maybe c)
previewByRef :: forall (effs :: EffectRow) af (is :: IxList) c.
(Member MockChainRead effs, Is af An_AffineFold) =>
Optic' af is TxSkelOut c -> TxOutRef -> Sem effs (Maybe c)
previewByRef Optic' af is TxSkelOut c
optic = (Optic' af is TxSkelOut c -> TxSkelOut -> Maybe c
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' af is TxSkelOut c
optic (TxSkelOut -> Maybe c) -> Sem effs TxSkelOut -> Sem effs (Maybe c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Sem effs TxSkelOut -> Sem effs (Maybe c))
-> (TxOutRef -> Sem effs TxSkelOut)
-> TxOutRef
-> Sem effs (Maybe c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> Sem effs TxSkelOut
forall (effs :: EffectRow).
Member MockChainRead effs =>
TxOutRef -> Sem effs TxSkelOut
txSkelOutByRef

-- | Gets the current official constitution script
getConstitutionScript ::
  (Member MockChainRead effs) =>
  Sem effs (Maybe VScript)

-- | Gets the current reward associated with a credential
getCurrentReward ::
  ( Member MockChainRead effs,
    Script.ToCredential c
  ) =>
  c ->
  Sem effs (Maybe Api.Lovelace)