{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE UndecidableInstances #-}
{-| Typeclass for blockchain operations
-}
module Convex.Class(
  MonadBlockchain(..),
  MonadMockchain(..),
  MonadBlockchainError(..),
  getSlot,
  setSlot,
  setPOSIXTime,
  nextSlot,
  setTimeToValidRange,
  getUtxo,
  setUtxo,

  -- * Implementation
  MonadBlockchainCardanoNodeT(..),
  runMonadBlockchainCardanoNodeT
) where

import qualified Cardano.Api                                       as C
import           Cardano.Api.Shelley                               (BabbageEra,
                                                                    CardanoMode,
                                                                    EraHistory (..),
                                                                    Hash,
                                                                    LocalNodeConnectInfo,
                                                                    NetworkId,
                                                                    PoolId,
                                                                    ScriptData,
                                                                    SlotNo, Tx,
                                                                    TxId)
import           Cardano.Ledger.Shelley.API                        (UTxO)
import           Cardano.Slotting.Time                             (SlotLength,
                                                                    SystemStart)
import           Control.Lens                                      (_1, view)
import           Control.Monad.Except                              (MonadError,
                                                                    catchError,
                                                                    runExceptT,
                                                                    throwError)
import           Control.Monad.IO.Class                            (MonadIO (..))
import           Control.Monad.Reader                              (MonadTrans,
                                                                    ReaderT (..),
                                                                    ask, asks,
                                                                    lift)
import qualified Control.Monad.State                               as LazyState
import qualified Control.Monad.State.Strict                        as StrictState
import           Control.Monad.Trans.Except                        (ExceptT)
import           Control.Monad.Trans.Except.Result                 (ResultT)
import           Convex.Era                                        (ERA)
import           Convex.MonadLog                                   (MonadLog (..),
                                                                    logInfoS,
                                                                    logWarnS)
import           Convex.Utils                                      (posixTimeToSlotUnsafe,
                                                                    slotToUtcTime)
import           Data.Aeson                                        (FromJSON,
                                                                    ToJSON)
import           Data.Set                                          (Set)
import qualified Data.Text                                         as Text
import           Data.Time.Clock                                   (UTCTime)
import           GHC.Generics                                      (Generic)
import           Ouroboros.Consensus.HardFork.History              (interpretQuery,
                                                                    slotToSlotLength)
import           Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (..))
import qualified PlutusLedgerApi.V1                                as PV1

{-| Send transactions and resolve tx inputs.
-}
class Monad m => MonadBlockchain m where
  sendTx                  :: Tx BabbageEra -> m TxId -- ^ Submit a transaction to the network
  utxoByTxIn              :: Set C.TxIn -> m (C.UTxO C.BabbageEra) -- ^ Resolve tx inputs
  queryProtocolParameters :: m (C.BundledProtocolParameters C.BabbageEra) -- ^ Get the protocol parameters
  queryStakePools         :: m (Set PoolId) -- ^ Get the stake pools
  querySystemStart        :: m SystemStart
  queryEraHistory         :: m (EraHistory CardanoMode)
  querySlotNo             :: m (SlotNo, SlotLength, UTCTime)
                          -- ^ returns the current slot number, slot length and begin utc time for slot.
                          -- Slot 0 is returned when at genesis.
  networkId               :: m NetworkId -- ^ Get the network id

instance MonadBlockchain m => MonadBlockchain (ResultT m) where
  sendTx :: Tx BabbageEra -> ResultT m TxId
sendTx = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadBlockchain m => Tx BabbageEra -> m TxId
sendTx
  utxoByTxIn :: Set TxIn -> ResultT m (UTxO BabbageEra)
utxoByTxIn = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockchain m =>
Set TxIn -> m (UTxO BabbageEra)
utxoByTxIn
  queryProtocolParameters :: ResultT m (BundledProtocolParameters BabbageEra)
queryProtocolParameters = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (BundledProtocolParameters BabbageEra)
queryProtocolParameters
  queryStakePools :: ResultT m (Set PoolId)
queryStakePools = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m (Set PoolId)
queryStakePools
  querySystemStart :: ResultT m SystemStart
querySystemStart = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m SystemStart
querySystemStart
  queryEraHistory :: ResultT m (EraHistory CardanoMode)
queryEraHistory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (EraHistory CardanoMode)
queryEraHistory
  querySlotNo :: ResultT m (SlotNo, SlotLength, UTCTime)
querySlotNo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (SlotNo, SlotLength, UTCTime)
querySlotNo
  networkId :: ResultT m NetworkId
networkId = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m NetworkId
networkId

instance MonadBlockchain m => MonadBlockchain (ExceptT e m) where
  sendTx :: Tx BabbageEra -> ExceptT e m TxId
sendTx = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadBlockchain m => Tx BabbageEra -> m TxId
sendTx
  utxoByTxIn :: Set TxIn -> ExceptT e m (UTxO BabbageEra)
utxoByTxIn = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockchain m =>
Set TxIn -> m (UTxO BabbageEra)
utxoByTxIn
  queryProtocolParameters :: ExceptT e m (BundledProtocolParameters BabbageEra)
queryProtocolParameters = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (BundledProtocolParameters BabbageEra)
queryProtocolParameters
  queryStakePools :: ExceptT e m (Set PoolId)
queryStakePools = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m (Set PoolId)
queryStakePools
  querySystemStart :: ExceptT e m SystemStart
querySystemStart = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m SystemStart
querySystemStart
  queryEraHistory :: ExceptT e m (EraHistory CardanoMode)
queryEraHistory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (EraHistory CardanoMode)
queryEraHistory
  querySlotNo :: ExceptT e m (SlotNo, SlotLength, UTCTime)
querySlotNo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (SlotNo, SlotLength, UTCTime)
querySlotNo
  networkId :: ExceptT e m NetworkId
networkId = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m NetworkId
networkId

instance MonadBlockchain m => MonadBlockchain (ReaderT e m) where
  sendTx :: Tx BabbageEra -> ReaderT e m TxId
sendTx = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadBlockchain m => Tx BabbageEra -> m TxId
sendTx
  utxoByTxIn :: Set TxIn -> ReaderT e m (UTxO BabbageEra)
utxoByTxIn = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockchain m =>
Set TxIn -> m (UTxO BabbageEra)
utxoByTxIn
  queryProtocolParameters :: ReaderT e m (BundledProtocolParameters BabbageEra)
queryProtocolParameters = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (BundledProtocolParameters BabbageEra)
queryProtocolParameters
  queryStakePools :: ReaderT e m (Set PoolId)
queryStakePools = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m (Set PoolId)
queryStakePools
  querySystemStart :: ReaderT e m SystemStart
querySystemStart = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m SystemStart
querySystemStart
  queryEraHistory :: ReaderT e m (EraHistory CardanoMode)
queryEraHistory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (EraHistory CardanoMode)
queryEraHistory
  querySlotNo :: ReaderT e m (SlotNo, SlotLength, UTCTime)
querySlotNo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (SlotNo, SlotLength, UTCTime)
querySlotNo
  networkId :: ReaderT e m NetworkId
networkId = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m NetworkId
networkId

instance MonadBlockchain m => MonadBlockchain (StrictState.StateT e m) where
  sendTx :: Tx BabbageEra -> StateT e m TxId
sendTx = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadBlockchain m => Tx BabbageEra -> m TxId
sendTx
  utxoByTxIn :: Set TxIn -> StateT e m (UTxO BabbageEra)
utxoByTxIn = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockchain m =>
Set TxIn -> m (UTxO BabbageEra)
utxoByTxIn
  queryProtocolParameters :: StateT e m (BundledProtocolParameters BabbageEra)
queryProtocolParameters = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (BundledProtocolParameters BabbageEra)
queryProtocolParameters
  queryStakePools :: StateT e m (Set PoolId)
queryStakePools = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m (Set PoolId)
queryStakePools
  querySystemStart :: StateT e m SystemStart
querySystemStart = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m SystemStart
querySystemStart
  queryEraHistory :: StateT e m (EraHistory CardanoMode)
queryEraHistory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (EraHistory CardanoMode)
queryEraHistory
  querySlotNo :: StateT e m (SlotNo, SlotLength, UTCTime)
querySlotNo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (SlotNo, SlotLength, UTCTime)
querySlotNo
  networkId :: StateT e m NetworkId
networkId = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m NetworkId
networkId

instance MonadBlockchain m => MonadBlockchain (LazyState.StateT e m) where
  sendTx :: Tx BabbageEra -> StateT e m TxId
sendTx = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadBlockchain m => Tx BabbageEra -> m TxId
sendTx
  utxoByTxIn :: Set TxIn -> StateT e m (UTxO BabbageEra)
utxoByTxIn = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBlockchain m =>
Set TxIn -> m (UTxO BabbageEra)
utxoByTxIn
  queryProtocolParameters :: StateT e m (BundledProtocolParameters BabbageEra)
queryProtocolParameters = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (BundledProtocolParameters BabbageEra)
queryProtocolParameters
  queryStakePools :: StateT e m (Set PoolId)
queryStakePools = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m (Set PoolId)
queryStakePools
  querySystemStart :: StateT e m SystemStart
querySystemStart = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m SystemStart
querySystemStart
  queryEraHistory :: StateT e m (EraHistory CardanoMode)
queryEraHistory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (EraHistory CardanoMode)
queryEraHistory
  querySlotNo :: StateT e m (SlotNo, SlotLength, UTCTime)
querySlotNo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
MonadBlockchain m =>
m (SlotNo, SlotLength, UTCTime)
querySlotNo
  networkId :: StateT e m NetworkId
networkId = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBlockchain m => m NetworkId
networkId

{-| Modify the mockchain internals
-}
class MonadBlockchain m => MonadMockchain m where
  modifySlot :: (SlotNo -> (SlotNo, a)) -> m a
  modifyUtxo :: (UTxO ERA -> (UTxO ERA, a)) -> m a

  {-| Look up the datum of a script hash, taking into account
  all datums that were part of transactions submitted with @sendTx@.
  -}
  resolveDatumHash :: Hash ScriptData -> m (Maybe ScriptData)

instance MonadMockchain m => MonadMockchain (ResultT m) where
  modifySlot :: forall a. (SlotNo -> (SlotNo, a)) -> ResultT m a
modifySlot = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(SlotNo -> (SlotNo, a)) -> m a
modifySlot
  modifyUtxo :: forall a. (UTxO ERA -> (UTxO ERA, a)) -> ResultT m a
modifyUtxo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(UTxO ERA -> (UTxO ERA, a)) -> m a
modifyUtxo
  resolveDatumHash :: Hash ScriptData -> ResultT m (Maybe ScriptData)
resolveDatumHash = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadMockchain m =>
Hash ScriptData -> m (Maybe ScriptData)
resolveDatumHash

instance MonadMockchain m => MonadMockchain (ReaderT e m) where
  modifySlot :: forall a. (SlotNo -> (SlotNo, a)) -> ReaderT e m a
modifySlot = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(SlotNo -> (SlotNo, a)) -> m a
modifySlot
  modifyUtxo :: forall a. (UTxO ERA -> (UTxO ERA, a)) -> ReaderT e m a
modifyUtxo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(UTxO ERA -> (UTxO ERA, a)) -> m a
modifyUtxo
  resolveDatumHash :: Hash ScriptData -> ReaderT e m (Maybe ScriptData)
resolveDatumHash = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadMockchain m =>
Hash ScriptData -> m (Maybe ScriptData)
resolveDatumHash

instance MonadMockchain m => MonadMockchain (ExceptT e m) where
  modifySlot :: forall a. (SlotNo -> (SlotNo, a)) -> ExceptT e m a
modifySlot = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(SlotNo -> (SlotNo, a)) -> m a
modifySlot
  modifyUtxo :: forall a. (UTxO ERA -> (UTxO ERA, a)) -> ExceptT e m a
modifyUtxo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(UTxO ERA -> (UTxO ERA, a)) -> m a
modifyUtxo
  resolveDatumHash :: Hash ScriptData -> ExceptT e m (Maybe ScriptData)
resolveDatumHash = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadMockchain m =>
Hash ScriptData -> m (Maybe ScriptData)
resolveDatumHash

instance MonadMockchain m => MonadMockchain (StrictState.StateT e m) where
  modifySlot :: forall a. (SlotNo -> (SlotNo, a)) -> StateT e m a
modifySlot = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(SlotNo -> (SlotNo, a)) -> m a
modifySlot
  modifyUtxo :: forall a. (UTxO ERA -> (UTxO ERA, a)) -> StateT e m a
modifyUtxo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(UTxO ERA -> (UTxO ERA, a)) -> m a
modifyUtxo
  resolveDatumHash :: Hash ScriptData -> StateT e m (Maybe ScriptData)
resolveDatumHash = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadMockchain m =>
Hash ScriptData -> m (Maybe ScriptData)
resolveDatumHash

instance MonadMockchain m => MonadMockchain (LazyState.StateT e m) where
  modifySlot :: forall a. (SlotNo -> (SlotNo, a)) -> StateT e m a
modifySlot = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(SlotNo -> (SlotNo, a)) -> m a
modifySlot
  modifyUtxo :: forall a. (UTxO ERA -> (UTxO ERA, a)) -> StateT e m a
modifyUtxo = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadMockchain m =>
(UTxO ERA -> (UTxO ERA, a)) -> m a
modifyUtxo
  resolveDatumHash :: Hash ScriptData -> StateT e m (Maybe ScriptData)
resolveDatumHash = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadMockchain m =>
Hash ScriptData -> m (Maybe ScriptData)
resolveDatumHash

{-| Get the current slot number
-}
getSlot :: MonadMockchain m => m SlotNo
getSlot :: forall (m :: * -> *). MonadMockchain m => m SlotNo
getSlot = forall (m :: * -> *) a.
MonadMockchain m =>
(SlotNo -> (SlotNo, a)) -> m a
modifySlot (\SlotNo
s -> (SlotNo
s, SlotNo
s))

{-| Get the current slot number
-}
setSlot :: MonadMockchain m => SlotNo -> m ()
setSlot :: forall (m :: * -> *). MonadMockchain m => SlotNo -> m ()
setSlot SlotNo
s = forall (m :: * -> *) a.
MonadMockchain m =>
(SlotNo -> (SlotNo, a)) -> m a
modifySlot (\SlotNo
_ -> (SlotNo
s, ()))

{-| Get the UTxO set |-}
getUtxo :: MonadMockchain m => m (UTxO ERA)
getUtxo :: forall (m :: * -> *). MonadMockchain m => m (UTxO ERA)
getUtxo = forall (m :: * -> *) a.
MonadMockchain m =>
(UTxO ERA -> (UTxO ERA, a)) -> m a
modifyUtxo (\UTxO ERA
s -> (UTxO ERA
s, UTxO ERA
s))

{-| Set the UTxO set |-}
setUtxo :: MonadMockchain m => UTxO ERA -> m ()
setUtxo :: forall (m :: * -> *). MonadMockchain m => UTxO ERA -> m ()
setUtxo UTxO ERA
u = forall (m :: * -> *) a.
MonadMockchain m =>
(UTxO ERA -> (UTxO ERA, a)) -> m a
modifyUtxo (forall a b. a -> b -> a
const (UTxO ERA
u, ()))

{-| Set the slot number to the slot that contains the given POSIX time.
-}
setPOSIXTime :: (MonadFail m, MonadMockchain m) => PV1.POSIXTime -> m ()
setPOSIXTime :: forall (m :: * -> *).
(MonadFail m, MonadMockchain m) =>
POSIXTime -> m ()
setPOSIXTime POSIXTime
tm =
  (forall mode.
EraHistory mode
-> SystemStart
-> POSIXTime
-> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
posixTimeToSlotUnsafe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadBlockchain m =>
m (EraHistory CardanoMode)
queryEraHistory forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadBlockchain m => m SystemStart
querySystemStart forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure POSIXTime
tm) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (m :: * -> *). MonadMockchain m => SlotNo -> m ()
setSlot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t a b. Field1 s t a b => Lens s t a b
_1)

{-| Change the clock so that the current slot time is within the given validity range.
This MAY move the clock backwards!
-}
setTimeToValidRange :: MonadMockchain m => (C.TxValidityLowerBound C.BabbageEra, C.TxValidityUpperBound C.BabbageEra) -> m ()
setTimeToValidRange :: forall (m :: * -> *).
MonadMockchain m =>
(TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
-> m ()
setTimeToValidRange = \case
  (C.TxValidityLowerBound ValidityLowerBoundSupportedInEra BabbageEra
_ SlotNo
lowerSlot, TxValidityUpperBound BabbageEra
_) -> forall (m :: * -> *). MonadMockchain m => SlotNo -> m ()
setSlot SlotNo
lowerSlot
  (TxValidityLowerBound BabbageEra
_, C.TxValidityUpperBound ValidityUpperBoundSupportedInEra BabbageEra
_ SlotNo
upperSlot) -> forall (m :: * -> *). MonadMockchain m => SlotNo -> m ()
setSlot (forall a. Enum a => a -> a
pred SlotNo
upperSlot)
  (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
_                                       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{-| Increase the slot number by 1.
-}
nextSlot :: MonadMockchain m => m ()
nextSlot :: forall (m :: * -> *). MonadMockchain m => m ()
nextSlot = forall (m :: * -> *) a.
MonadMockchain m =>
(SlotNo -> (SlotNo, a)) -> m a
modifySlot (\SlotNo
s -> (forall a. Enum a => a -> a
succ SlotNo
s, ()))

data MonadBlockchainError e =
  MonadBlockchainError e
  | ProtocolConversionError Text.Text
  | FailWith String
  deriving stock (MonadBlockchainError e -> MonadBlockchainError e -> Bool
forall e.
Eq e =>
MonadBlockchainError e -> MonadBlockchainError e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonadBlockchainError e -> MonadBlockchainError e -> Bool
$c/= :: forall e.
Eq e =>
MonadBlockchainError e -> MonadBlockchainError e -> Bool
== :: MonadBlockchainError e -> MonadBlockchainError e -> Bool
$c== :: forall e.
Eq e =>
MonadBlockchainError e -> MonadBlockchainError e -> Bool
Eq, forall a b. a -> MonadBlockchainError b -> MonadBlockchainError a
forall a b.
(a -> b) -> MonadBlockchainError a -> MonadBlockchainError b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MonadBlockchainError b -> MonadBlockchainError a
$c<$ :: forall a b. a -> MonadBlockchainError b -> MonadBlockchainError a
fmap :: forall a b.
(a -> b) -> MonadBlockchainError a -> MonadBlockchainError b
$cfmap :: forall a b.
(a -> b) -> MonadBlockchainError a -> MonadBlockchainError b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x.
Rep (MonadBlockchainError e) x -> MonadBlockchainError e
forall e x.
MonadBlockchainError e -> Rep (MonadBlockchainError e) x
$cto :: forall e x.
Rep (MonadBlockchainError e) x -> MonadBlockchainError e
$cfrom :: forall e x.
MonadBlockchainError e -> Rep (MonadBlockchainError e) x
Generic)
  deriving anyclass (forall e. ToJSON e => [MonadBlockchainError e] -> Encoding
forall e. ToJSON e => [MonadBlockchainError e] -> Value
forall e. ToJSON e => MonadBlockchainError e -> Encoding
forall e. ToJSON e => MonadBlockchainError e -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MonadBlockchainError e] -> Encoding
$ctoEncodingList :: forall e. ToJSON e => [MonadBlockchainError e] -> Encoding
toJSONList :: [MonadBlockchainError e] -> Value
$ctoJSONList :: forall e. ToJSON e => [MonadBlockchainError e] -> Value
toEncoding :: MonadBlockchainError e -> Encoding
$ctoEncoding :: forall e. ToJSON e => MonadBlockchainError e -> Encoding
toJSON :: MonadBlockchainError e -> Value
$ctoJSON :: forall e. ToJSON e => MonadBlockchainError e -> Value
ToJSON, forall e. FromJSON e => Value -> Parser [MonadBlockchainError e]
forall e. FromJSON e => Value -> Parser (MonadBlockchainError e)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MonadBlockchainError e]
$cparseJSONList :: forall e. FromJSON e => Value -> Parser [MonadBlockchainError e]
parseJSON :: Value -> Parser (MonadBlockchainError e)
$cparseJSON :: forall e. FromJSON e => Value -> Parser (MonadBlockchainError e)
FromJSON)

protocolConversionError :: C.ProtocolParametersConversionError -> MonadBlockchainError e
protocolConversionError :: forall e.
ProtocolParametersConversionError -> MonadBlockchainError e
protocolConversionError = forall e. Text -> MonadBlockchainError e
ProtocolConversionError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
C.textShow

instance Show e => Show (MonadBlockchainError e) where
  show :: MonadBlockchainError e -> String
show (MonadBlockchainError e
e)    = forall a. Show a => a -> String
show e
e
  show (FailWith String
str)              = String
str
  show (ProtocolConversionError Text
e) = forall a. Show a => a -> String
show Text
e

{-| 'MonadBlockchain' implementation that connects to a cardano node
-}
newtype MonadBlockchainCardanoNodeT e m a = MonadBlockchainCardanoNodeT { forall e (m :: * -> *) a.
MonadBlockchainCardanoNodeT e m a
-> ReaderT
     (LocalNodeConnectInfo CardanoMode)
     (ExceptT (MonadBlockchainError e) m)
     a
unMonadBlockchainCardanoNodeT :: ReaderT (LocalNodeConnectInfo CardanoMode) (ExceptT (MonadBlockchainError e) m) a }
  deriving newtype (forall a b.
a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m a
forall a b.
(a -> b)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
forall e (m :: * -> *) a b.
Functor m =>
a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m a
fmap :: forall a b.
(a -> b)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
Functor, forall a. a -> MonadBlockchainCardanoNodeT e m a
forall a b.
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m a
forall a b.
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m b
forall a b.
MonadBlockchainCardanoNodeT e m (a -> b)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
forall a b c.
(a -> b -> c)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m c
forall {e} {m :: * -> *}.
Monad m =>
Functor (MonadBlockchainCardanoNodeT e m)
forall e (m :: * -> *) a.
Monad m =>
a -> MonadBlockchainCardanoNodeT e m a
forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m a
forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m b
forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m (a -> b)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e 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 a b.
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m a
$c<* :: forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m a
*> :: forall a b.
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m b
$c*> :: forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m b
liftA2 :: forall a b c.
(a -> b -> c)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m c
<*> :: forall a b.
MonadBlockchainCardanoNodeT e m (a -> b)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m (a -> b)
-> MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
pure :: forall a. a -> MonadBlockchainCardanoNodeT e m a
$cpure :: forall e (m :: * -> *) a.
Monad m =>
a -> MonadBlockchainCardanoNodeT e m a
Applicative, forall a. a -> MonadBlockchainCardanoNodeT e m a
forall a b.
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m b
forall a b.
MonadBlockchainCardanoNodeT e m a
-> (a -> MonadBlockchainCardanoNodeT e m b)
-> MonadBlockchainCardanoNodeT e m b
forall e (m :: * -> *).
Monad m =>
Applicative (MonadBlockchainCardanoNodeT e m)
forall e (m :: * -> *) a.
Monad m =>
a -> MonadBlockchainCardanoNodeT e m a
forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m b
forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m a
-> (a -> MonadBlockchainCardanoNodeT e m b)
-> MonadBlockchainCardanoNodeT e 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
return :: forall a. a -> MonadBlockchainCardanoNodeT e m a
$creturn :: forall e (m :: * -> *) a.
Monad m =>
a -> MonadBlockchainCardanoNodeT e m a
>> :: forall a b.
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m a
-> MonadBlockchainCardanoNodeT e m b
-> MonadBlockchainCardanoNodeT e m b
>>= :: forall a b.
MonadBlockchainCardanoNodeT e m a
-> (a -> MonadBlockchainCardanoNodeT e m b)
-> MonadBlockchainCardanoNodeT e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
MonadBlockchainCardanoNodeT e m a
-> (a -> MonadBlockchainCardanoNodeT e m b)
-> MonadBlockchainCardanoNodeT e m b
Monad, forall a. IO a -> MonadBlockchainCardanoNodeT e m a
forall {e} {m :: * -> *}.
MonadIO m =>
Monad (MonadBlockchainCardanoNodeT e m)
forall e (m :: * -> *) a.
MonadIO m =>
IO a -> MonadBlockchainCardanoNodeT e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> MonadBlockchainCardanoNodeT e m a
$cliftIO :: forall e (m :: * -> *) a.
MonadIO m =>
IO a -> MonadBlockchainCardanoNodeT e m a
MonadIO)

instance MonadError e m => MonadError e (MonadBlockchainCardanoNodeT e m) where
  throwError :: forall a. e -> MonadBlockchainCardanoNodeT e m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a.
MonadBlockchainCardanoNodeT e m a
-> (e -> MonadBlockchainCardanoNodeT e m a)
-> MonadBlockchainCardanoNodeT e m a
catchError MonadBlockchainCardanoNodeT e m a
m e -> MonadBlockchainCardanoNodeT e m a
_ = MonadBlockchainCardanoNodeT e m a
m


runMonadBlockchainCardanoNodeT :: LocalNodeConnectInfo CardanoMode -> MonadBlockchainCardanoNodeT e m a -> m (Either (MonadBlockchainError e) a)
runMonadBlockchainCardanoNodeT :: forall e (m :: * -> *) a.
LocalNodeConnectInfo CardanoMode
-> MonadBlockchainCardanoNodeT e m a
-> m (Either (MonadBlockchainError e) a)
runMonadBlockchainCardanoNodeT LocalNodeConnectInfo CardanoMode
info (MonadBlockchainCardanoNodeT ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
action) = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
action LocalNodeConnectInfo CardanoMode
info)

runQuery :: (MonadIO m, MonadLog m) => C.QueryInMode CardanoMode a -> MonadBlockchainCardanoNodeT e m a
runQuery :: forall (m :: * -> *) a e.
(MonadIO m, MonadLog m) =>
QueryInMode CardanoMode a -> MonadBlockchainCardanoNodeT e m a
runQuery QueryInMode CardanoMode a
qry = forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT forall a b. (a -> b) -> a -> b
$ do
  LocalNodeConnectInfo CardanoMode
info <- forall r (m :: * -> *). MonadReader r m => m r
ask
  Either AcquiringFailure a
result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquiringFailure result)
C.queryNodeLocalState LocalNodeConnectInfo CardanoMode
info forall a. Maybe a
Nothing QueryInMode CardanoMode a
qry)
  case Either AcquiringFailure a
result of
    Left AcquiringFailure
err -> do
      let msg :: String
msg = String
"runQuery: Query failed: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AcquiringFailure
err
      forall (m :: * -> *). MonadLog m => String -> m ()
logWarnS String
msg
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e. String -> MonadBlockchainError e
FailWith String
msg
    Right a
result' -> do
      forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result'

runQuery' :: (MonadIO m, MonadLog m, Show e1) => C.QueryInMode CardanoMode (Either e1 a) -> MonadBlockchainCardanoNodeT e2 m a
runQuery' :: forall (m :: * -> *) e1 a e2.
(MonadIO m, MonadLog m, Show e1) =>
QueryInMode CardanoMode (Either e1 a)
-> MonadBlockchainCardanoNodeT e2 m a
runQuery' QueryInMode CardanoMode (Either e1 a)
qry = forall (m :: * -> *) a e.
(MonadIO m, MonadLog m) =>
QueryInMode CardanoMode a -> MonadBlockchainCardanoNodeT e m a
runQuery QueryInMode CardanoMode (Either e1 a)
qry forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left e1
err -> forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT forall a b. (a -> b) -> a -> b
$ do
    let msg :: String
msg = String
"runQuery': Era mismatch: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show e1
err
    forall (m :: * -> *). MonadLog m => String -> m ()
logWarnS String
msg
    forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e. String -> MonadBlockchainError e
FailWith String
msg
  Right a
result' -> forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). MonadLog m => String -> m ()
logInfoS String
"runQuery': Success"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result'

instance (MonadLog m, MonadIO m) => MonadBlockchain (MonadBlockchainCardanoNodeT e m) where
  sendTx :: Tx BabbageEra -> MonadBlockchainCardanoNodeT e m TxId
sendTx Tx BabbageEra
tx = forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT forall a b. (a -> b) -> a -> b
$ do
    let txId :: TxId
txId = forall era. TxBody era -> TxId
C.getTxId (forall era. Tx era -> TxBody era
C.getTxBody Tx BabbageEra
tx)
    LocalNodeConnectInfo CardanoMode
info <- forall r (m :: * -> *). MonadReader r m => m r
ask
    SubmitResult (TxValidationErrorInMode CardanoMode)
result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall mode.
LocalNodeConnectInfo mode
-> TxInMode mode
-> IO (SubmitResult (TxValidationErrorInMode mode))
C.submitTxToNodeLocal LocalNodeConnectInfo CardanoMode
info (forall era mode. Tx era -> EraInMode era mode -> TxInMode mode
C.TxInMode Tx BabbageEra
tx EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode))
    -- TODO: Error should be reflected in return type of 'sendTx'
    case SubmitResult (TxValidationErrorInMode CardanoMode)
result of
      SubmitResult (TxValidationErrorInMode CardanoMode)
SubmitSuccess -> do
        forall (m :: * -> *). MonadLog m => String -> m ()
logInfoS (String
"sendTx: Submitted " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TxId
txId)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure TxId
txId
      SubmitFail TxValidationErrorInMode CardanoMode
reason -> do
        let msg :: String
msg = String
"sendTx: Submission failed: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TxValidationErrorInMode CardanoMode
reason
        forall (m :: * -> *). MonadLog m => String -> m ()
logWarnS String
msg
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e. String -> MonadBlockchainError e
FailWith String
msg

  utxoByTxIn :: Set TxIn -> MonadBlockchainCardanoNodeT e m (UTxO BabbageEra)
utxoByTxIn Set TxIn
txIns =
    forall (m :: * -> *) e1 a e2.
(MonadIO m, MonadLog m, Show e1) =>
QueryInMode CardanoMode (Either e1 a)
-> MonadBlockchainCardanoNodeT e2 m a
runQuery' (forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
C.QueryInEra EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode (forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
C.QueryInShelleyBasedEra ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage (forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
C.QueryUTxO (Set TxIn -> QueryUTxOFilter
C.QueryUTxOByTxIn Set TxIn
txIns))))

  queryProtocolParameters :: MonadBlockchainCardanoNodeT
  e m (BundledProtocolParameters BabbageEra)
queryProtocolParameters = do
    ProtocolParameters
p <- forall (m :: * -> *) e1 a e2.
(MonadIO m, MonadLog m, Show e1) =>
QueryInMode CardanoMode (Either e1 a)
-> MonadBlockchainCardanoNodeT e2 m a
runQuery' (forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
C.QueryInEra EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode (forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
C.QueryInShelleyBasedEra ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage forall era. QueryInShelleyBasedEra era ProtocolParameters
C.QueryProtocolParameters))
    case forall era.
CardanoEra era
-> ProtocolParameters
-> Either
     ProtocolParametersConversionError (BundledProtocolParameters era)
C.bundleProtocolParams CardanoEra BabbageEra
C.BabbageEra ProtocolParameters
p of
      Right BundledProtocolParameters BabbageEra
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BundledProtocolParameters BabbageEra
x
      Left ProtocolParametersConversionError
err -> forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall e.
ProtocolParametersConversionError -> MonadBlockchainError e
protocolConversionError ProtocolParametersConversionError
err)

  queryStakePools :: MonadBlockchainCardanoNodeT e m (Set PoolId)
queryStakePools =
    forall (m :: * -> *) e1 a e2.
(MonadIO m, MonadLog m, Show e1) =>
QueryInMode CardanoMode (Either e1 a)
-> MonadBlockchainCardanoNodeT e2 m a
runQuery' (forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
C.QueryInEra EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode (forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
C.QueryInShelleyBasedEra ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage forall era. QueryInShelleyBasedEra era (Set PoolId)
C.QueryStakePools))

  querySystemStart :: MonadBlockchainCardanoNodeT e m SystemStart
querySystemStart = forall (m :: * -> *) a e.
(MonadIO m, MonadLog m) =>
QueryInMode CardanoMode a -> MonadBlockchainCardanoNodeT e m a
runQuery forall mode. QueryInMode mode SystemStart
C.QuerySystemStart

  queryEraHistory :: MonadBlockchainCardanoNodeT e m (EraHistory CardanoMode)
queryEraHistory = forall (m :: * -> *) a e.
(MonadIO m, MonadLog m) =>
QueryInMode CardanoMode a -> MonadBlockchainCardanoNodeT e m a
runQuery (forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
C.QueryEraHistory ConsensusModeIsMultiEra CardanoMode
C.CardanoModeIsMultiEra)

  querySlotNo :: MonadBlockchainCardanoNodeT e m (SlotNo, SlotLength, UTCTime)
querySlotNo = do
    (eraHistory :: EraHistory CardanoMode
eraHistory@(EraHistory ConsensusMode CardanoMode
_ Interpreter xs
interpreter), SystemStart
systemStart) <- (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadBlockchain m =>
m (EraHistory CardanoMode)
queryEraHistory forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadBlockchain m => m SystemStart
querySystemStart
    SlotNo
slotNo <- forall (m :: * -> *) a e.
(MonadIO m, MonadLog m) =>
QueryInMode CardanoMode a -> MonadBlockchainCardanoNodeT e m a
runQuery (forall mode. ConsensusMode mode -> QueryInMode mode ChainPoint
C.QueryChainPoint ConsensusMode CardanoMode
C.CardanoMode) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                ChainPoint
C.ChainPointAtGenesis  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
0 :: Integer)
                C.ChainPoint SlotNo
slot Hash BlockHeader
_hsh -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SlotNo
slot
    forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT forall a b. (a -> b) -> a -> b
$ do
      let logErr :: String -> m b
logErr String
err = do
            let msg :: String
msg = String
"querySlotNo: Failed with " forall a. Semigroup a => a -> a -> a
<> String
err
            forall (m :: * -> *). MonadLog m => String -> m ()
logWarnS String
msg
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e. String -> MonadBlockchainError e
FailWith String
msg
      UTCTime
utctime <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {e} {b}.
(MonadLog m, MonadError (MonadBlockchainError e) m) =>
String -> m b
logErr forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall mode.
EraHistory mode -> SystemStart -> SlotNo -> Either String UTCTime
slotToUtcTime EraHistory CardanoMode
eraHistory SystemStart
systemStart SlotNo
slotNo)
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {m :: * -> *} {e} {b}.
(MonadLog m, MonadError (MonadBlockchainError e) m) =>
String -> m b
logErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (\SlotLength
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slotNo, SlotLength
l, UTCTime
utctime)) (forall (xs :: [*]) a.
HasCallStack =>
Interpreter xs -> Qry a -> Either PastHorizonException a
interpretQuery Interpreter xs
interpreter forall a b. (a -> b) -> a -> b
$ SlotNo -> Qry SlotLength
slotToSlotLength SlotNo
slotNo)

  networkId :: MonadBlockchainCardanoNodeT e m NetworkId
networkId = forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall mode. LocalNodeConnectInfo mode -> NetworkId
C.localNodeNetworkId)

instance MonadTrans (MonadBlockchainCardanoNodeT e) where
  lift :: forall (m :: * -> *) a.
Monad m =>
m a -> MonadBlockchainCardanoNodeT e m a
lift = forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadLog m) => MonadLog (MonadBlockchainCardanoNodeT e m) where
  logInfo' :: Doc Void -> MonadBlockchainCardanoNodeT e m ()
logInfo' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logInfo'
  logWarn' :: Doc Void -> MonadBlockchainCardanoNodeT e m ()
logWarn' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logWarn'
  logDebug' :: Doc Void -> MonadBlockchainCardanoNodeT e m ()
logDebug' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logDebug'

instance (MonadLog m) => MonadFail (MonadBlockchainCardanoNodeT e m) where
  fail :: forall a. String -> MonadBlockchainCardanoNodeT e m a
fail = forall e (m :: * -> *) a.
ReaderT
  (LocalNodeConnectInfo CardanoMode)
  (ExceptT (MonadBlockchainError e) m)
  a
-> MonadBlockchainCardanoNodeT e m a
MonadBlockchainCardanoNodeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> MonadBlockchainError e
FailWith