{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provide infrastructure-independent "handlers" for posting transactions and following the chain.
--
-- This module encapsulates the transformation logic between cardano transactions and `HydraNode` abstractions
-- `PostChainTx` and `OnChainTx`, and maintenance of on-chain relevant state.
module Hydra.Chain.Direct.Handlers where

import Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Api (ppMaxValSizeL)
import Cardano.Ledger.BaseTypes (ProtVer (..))
import Cardano.Ledger.Binary (serialize)
import Cardano.Ledger.Core (PParams, ppMaxTxSizeL, ppProtocolVersionL)
import Cardano.Slotting.Slot (SlotNo (..))
import Control.Concurrent.Class.MonadSTM (modifyTVar, writeTVar)
import Control.Lens ((^.))
import Control.Monad.Class.MonadSTM (throwSTM)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Map.Strict qualified as Map
import Hydra.Cardano.Api (
  Address,
  BlockHeader,
  ByronAddr,
  ChainPoint (..),
  LedgerEra,
  Tx,
  TxId,
  TxIn,
  TxOut,
  UTxO,
  Value,
  calculateMinimumUTxO,
  chainPointToSlotNo,
  fromCtxUTxOTxOut,
  getChainPoint,
  getTxBody,
  getTxId,
  liftEither,
  serialiseToCBOR,
  shelleyBasedEra,
  throwError,
  toLedgerValue,
  txOutAddress,
  txOutValue,
  txOuts',
  pattern ByronAddressInEra,
 )
import Hydra.Chain (
  Chain (..),
  ChainCallback,
  ChainEvent (..),
  ChainStateHistory,
  OnChainTx (..),
  PostChainTx (..),
  PostTxError (..),
  currentState,
  pushNewState,
  rollbackHistory,
 )
import Hydra.Chain.ChainState (
  ChainSlot,
  ChainStateType,
  IsChainState,
 )
import Hydra.Chain.Direct.State (
  ChainContext (..),
  ChainStateAt (..),
  PartialFanoutError (..),
  chainSlotFromPoint,
  close,
  contest,
  decrement,
  dryRunIncrementTx,
  fanout,
  finalPartialFanout,
  getKnownUTxO,
  increment,
  initialize,
  partialFanout,
  recover,
 )
import Hydra.Chain.Direct.TimeHandle (TimeHandle (..))
import Hydra.Chain.Direct.Wallet (
  ErrCoverFee (..),
  TinyWallet (..),
  TinyWalletLog,
 )
import Hydra.Ledger.Cardano (adjustUTxO, fromChainSlot)
import Hydra.Ledger.Cardano.Evaluate (EvaluationError (..), EvaluationReport, renderEvaluationReport)
import Hydra.Logging (Tracer, traceWith)
import Hydra.Node.Util (checkNonADAAssetsUTxO)
import Hydra.Tx (
  CommitBlueprintTx (..),
  ConfirmedSnapshot,
  HeadId,
  HeadParameters (..),
  IsTx (..),
  UTxOType,
  headSeedToTxIn,
 )
import Hydra.Tx.ContestationPeriod (toNominalDiffTime)
import Hydra.Tx.Deposit (DepositObservation (..), depositTx)
import Hydra.Tx.Observe (
  CloseObservation (..),
  ContestObservation (..),
  DecrementObservation (..),
  FanoutObservation (..),
  HeadObservation (..),
  IncrementObservation (..),
  InitObservation (..),
  PartialFanoutObservation (..),
  observeHeadTx,
 )
import Hydra.Tx.Recover (RecoverObservation (..))
import Hydra.Tx.Snapshot (getSnapshot, snapshotUTxO)
import System.IO.Error (userError)

-- | Handle of a mutable local chain state that is kept in the direct chain layer.
data LocalChainState m tx = LocalChainState
  { forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateType tx)
getLatest :: STM m (ChainStateType tx)
  , forall (m :: * -> *) tx.
LocalChainState m tx -> ChainStateType tx -> STM m ()
pushNew :: ChainStateType tx -> STM m ()
  , forall (m :: * -> *) tx.
LocalChainState m tx -> ChainSlot -> STM m (ChainStateType tx)
rollback :: ChainSlot -> STM m (ChainStateType tx)
  , forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateHistory tx)
history :: STM m (ChainStateHistory tx)
  }

-- | Initialize a new local chain state from a given chain state history.
newLocalChainState ::
  forall m tx.
  (IsChainState tx, MonadLabelledSTM m) =>
  ChainStateHistory tx ->
  m (LocalChainState m tx)
newLocalChainState :: forall (m :: * -> *) tx.
(IsChainState tx, MonadLabelledSTM m) =>
ChainStateHistory tx -> m (LocalChainState m tx)
newLocalChainState ChainStateHistory tx
chainState = do
  TVar m (ChainStateHistory tx)
tv <- String -> ChainStateHistory tx -> m (TVar m (ChainStateHistory tx))
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> a -> m (TVar m a)
newLabelledTVarIO String
"local-chain-state" ChainStateHistory tx
chainState
  LocalChainState m tx -> m (LocalChainState m tx)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    LocalChainState
      { $sel:getLatest:LocalChainState :: STM m (ChainStateType tx)
getLatest = TVar m (ChainStateHistory tx) -> STM m (ChainStateType tx)
getLatest TVar m (ChainStateHistory tx)
tv
      , $sel:pushNew:LocalChainState :: ChainStateType tx -> STM m ()
pushNew = TVar m (ChainStateHistory tx) -> ChainStateType tx -> STM m ()
pushNew TVar m (ChainStateHistory tx)
tv
      , $sel:rollback:LocalChainState :: ChainSlot -> STM m (ChainStateType tx)
rollback = TVar m (ChainStateHistory tx)
-> ChainSlot -> STM m (ChainStateType tx)
rollback TVar m (ChainStateHistory tx)
tv
      , $sel:history:LocalChainState :: STM m (ChainStateHistory tx)
history = TVar m (ChainStateHistory tx) -> STM m (ChainStateHistory tx)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (ChainStateHistory tx)
tv
      }
 where
  -- REVIEW: why using `currentState` instead of `lastKnown` ???
  getLatest :: TVar m (ChainStateHistory tx) -> STM m (ChainStateType tx)
  getLatest :: TVar m (ChainStateHistory tx) -> STM m (ChainStateType tx)
getLatest TVar m (ChainStateHistory tx)
tv = ChainStateHistory tx -> ChainStateType tx
forall tx. ChainStateHistory tx -> ChainStateType tx
currentState (ChainStateHistory tx -> ChainStateType tx)
-> STM m (ChainStateHistory tx) -> STM m (ChainStateType tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar m (ChainStateHistory tx) -> STM m (ChainStateHistory tx)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (ChainStateHistory tx)
tv

  pushNew :: TVar m (ChainStateHistory tx) -> ChainStateType tx -> STM m ()
  pushNew :: TVar m (ChainStateHistory tx) -> ChainStateType tx -> STM m ()
pushNew TVar m (ChainStateHistory tx)
tv ChainStateType tx
cs =
    TVar m (ChainStateHistory tx)
-> (ChainStateHistory tx -> ChainStateHistory tx) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar TVar m (ChainStateHistory tx)
tv (ChainStateType tx -> ChainStateHistory tx -> ChainStateHistory tx
forall tx.
IsChainState tx =>
ChainStateType tx -> ChainStateHistory tx -> ChainStateHistory tx
pushNewState ChainStateType tx
cs)

  rollback :: TVar m (ChainStateHistory tx) -> ChainSlot -> STM m (ChainStateType tx)
  rollback :: TVar m (ChainStateHistory tx)
-> ChainSlot -> STM m (ChainStateType tx)
rollback TVar m (ChainStateHistory tx)
tv ChainSlot
chainSlot = do
    ChainStateHistory tx
rolledBack <-
      TVar m (ChainStateHistory tx) -> STM m (ChainStateHistory tx)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (ChainStateHistory tx)
tv
        STM m (ChainStateHistory tx)
-> (ChainStateHistory tx -> ChainStateHistory tx)
-> STM m (ChainStateHistory tx)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ChainSlot -> ChainStateHistory tx -> ChainStateHistory tx
forall tx.
IsChainState tx =>
ChainSlot -> ChainStateHistory tx -> ChainStateHistory tx
rollbackHistory ChainSlot
chainSlot
    TVar m (ChainStateHistory tx) -> ChainStateHistory tx -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (ChainStateHistory tx)
tv ChainStateHistory tx
rolledBack
    ChainStateType tx -> STM m (ChainStateType tx)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainStateHistory tx -> ChainStateType tx
forall tx. ChainStateHistory tx -> ChainStateType tx
currentState ChainStateHistory tx
rolledBack)

-- * Posting Transactions

-- | A callback used to actually submit a transaction to the chain.
type SubmitTx m = Tx -> m ()

-- | A way to acquire a 'TimeHandle'
type GetTimeHandle m = m TimeHandle

-- | Create a `Chain` component for posting "real" cardano transactions.
--
-- This component does not actually interact with a cardano-node, but creates
-- cardano transactions from `PostChainTx` transactions emitted by a
-- `HydraNode`, balancing and signing them using given `TinyWallet`, before
-- handing it off to the given 'SubmitTx' callback. There is also a 'draftTx'
-- option for drafting a commit tx on behalf of the user using their selected
-- utxo.
--
-- NOTE: Given the constraints on `m` this function should work within `IOSim`
-- and does not require any actual `IO` to happen which makes it highly suitable
-- for simulations and testing.
mkChain ::
  (MonadSTM m, MonadThrow (STM m)) =>
  Tracer m CardanoChainLog ->
  -- | Means to acquire a new 'TimeHandle'.
  GetTimeHandle m ->
  TinyWallet m ->
  ChainContext ->
  LocalChainState m Tx ->
  SubmitTx m ->
  Chain Tx m
mkChain :: forall (m :: * -> *).
(MonadSTM m, MonadThrow (STM m)) =>
Tracer m CardanoChainLog
-> GetTimeHandle m
-> TinyWallet m
-> ChainContext
-> LocalChainState m Tx
-> SubmitTx m
-> Chain Tx m
mkChain Tracer m CardanoChainLog
tracer GetTimeHandle m
queryTimeHandle TinyWallet m
wallet ChainContext
ctx LocalChainState{STM m (ChainStateType Tx)
$sel:getLatest:LocalChainState :: forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateType tx)
getLatest :: STM m (ChainStateType Tx)
getLatest} SubmitTx m
submitTx =
  Chain
    { $sel:postTx:Chain :: MonadThrow m => PostChainTx Tx -> m ()
postTx = \PostChainTx Tx
tx -> do
        ChainStateAt{UTxO
spendableUTxO :: UTxO
$sel:spendableUTxO:ChainStateAt :: ChainStateAt -> UTxO
spendableUTxO} <- STM m ChainStateAt -> m ChainStateAt
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (ChainStateType Tx)
STM m ChainStateAt
getLatest
        Tracer m CardanoChainLog -> CardanoChainLog -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m CardanoChainLog
tracer (CardanoChainLog -> m ()) -> CardanoChainLog -> m ()
forall a b. (a -> b) -> a -> b
$ ToPost{$sel:toPost:ToPost :: PostChainTx Tx
toPost = PostChainTx Tx
tx}
        TimeHandle
timeHandle <- GetTimeHandle m
queryTimeHandle
        let TimeHandle{UTCTime -> Either Text SlotNo
slotFromUTCTime :: UTCTime -> Either Text SlotNo
$sel:slotFromUTCTime:TimeHandle :: TimeHandle -> UTCTime -> Either Text SlotNo
slotFromUTCTime} = TimeHandle
timeHandle
            resolveHeadInfo :: HeadSeed -> UTCTime -> m (SlotNo, TxIn)
resolveHeadInfo HeadSeed
headSeed UTCTime
deadline = do
              SlotNo
slot <- (Text -> m SlotNo)
-> (SlotNo -> m SlotNo) -> Either Text SlotNo -> m SlotNo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
err -> PostTxError Tx -> m SlotNo
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ContestationDeadlineOutsideTimeHorizon{$sel:failureReason:NoSeedInput :: Text
failureReason = Text
err} :: PostTxError Tx)) SlotNo -> m SlotNo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text SlotNo -> m SlotNo) -> Either Text SlotNo -> m SlotNo
forall a b. (a -> b) -> a -> b
$ UTCTime -> Either Text SlotNo
slotFromUTCTime UTCTime
deadline
              TxIn
tin <- m TxIn -> (TxIn -> m TxIn) -> Maybe TxIn -> m TxIn
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PostTxError Tx -> m TxIn
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (InvalidSeed{HeadSeed
headSeed :: HeadSeed
$sel:headSeed:NoSeedInput :: HeadSeed
headSeed} :: PostTxError Tx)) TxIn -> m TxIn
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TxIn -> m TxIn) -> Maybe TxIn -> m TxIn
forall a b. (a -> b) -> a -> b
$ HeadSeed -> Maybe TxIn
forall (m :: * -> *). MonadFail m => HeadSeed -> m TxIn
headSeedToTxIn HeadSeed
headSeed
              (SlotNo, TxIn) -> m (SlotNo, TxIn)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slot, TxIn
tin)
        Tx
vtx <- case PostChainTx Tx
tx of
          FanoutTx{UTxOType Tx
utxo :: UTxOType Tx
$sel:utxo:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxo, Maybe (UTxOType Tx)
utxoToCommit :: Maybe (UTxOType Tx)
$sel:utxoToCommit:InitTx :: forall tx. PostChainTx tx -> Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType Tx)
utxoToDecommit :: Maybe (UTxOType Tx)
$sel:utxoToDecommit:InitTx :: forall tx. PostChainTx tx -> Maybe (UTxOType tx)
utxoToDecommit, UTxOType Tx
utxoForProof :: UTxOType Tx
$sel:utxoForProof:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxoForProof, HeadSeed
headSeed :: HeadSeed
$sel:headSeed:InitTx :: forall tx. PostChainTx tx -> HeadSeed
headSeed, UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:InitTx :: forall tx. PostChainTx tx -> UTCTime
contestationDeadline} -> do
            (SlotNo
deadlineSlot, TxIn
seedTxIn) <- HeadSeed -> UTCTime -> m (SlotNo, TxIn)
resolveHeadInfo HeadSeed
headSeed UTCTime
contestationDeadline
            let fullUTxO :: UTxO
fullUTxO = UTxOType Tx
UTxO
utxo UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> Maybe UTxO -> UTxO
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe (UTxOType Tx)
Maybe UTxO
utxoToCommit UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> Maybe UTxO -> UTxO
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe (UTxOType Tx)
Maybe UTxO
utxoToDecommit
            Tracer m CardanoChainLog
-> TinyWallet m
-> ChainContext
-> UTxO
-> TxIn
-> Maybe Tx
-> UTxO
-> UTxO
-> Int
-> SlotNo
-> m Tx
forall (m :: * -> *).
MonadThrow m =>
Tracer m CardanoChainLog
-> TinyWallet m
-> ChainContext
-> UTxO
-> TxIn
-> Maybe Tx
-> UTxO
-> UTxO
-> Int
-> SlotNo
-> m Tx
findFittingFanoutTx
              Tracer m CardanoChainLog
tracer
              TinyWallet m
wallet
              ChainContext
ctx
              UTxO
spendableUTxO
              TxIn
seedTxIn
              (Either FanoutTxError Tx -> Maybe Tx
forall l r. Either l r -> Maybe r
rightToMaybe (ChainContext
-> UTxO
-> TxIn
-> UTxO
-> Maybe UTxO
-> Maybe UTxO
-> UTxO
-> SlotNo
-> Either FanoutTxError Tx
fanout ChainContext
ctx UTxO
spendableUTxO TxIn
seedTxIn UTxOType Tx
UTxO
utxo Maybe (UTxOType Tx)
Maybe UTxO
utxoToCommit Maybe (UTxOType Tx)
Maybe UTxO
utxoToDecommit UTxOType Tx
UTxO
utxoForProof SlotNo
deadlineSlot))
              UTxOType Tx
UTxO
utxoForProof
              UTxO
fullUTxO
              (UTxO -> Int
forall era. UTxO era -> Int
UTxO.size UTxO
fullUTxO Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              SlotNo
deadlineSlot
              m Tx -> (Tx -> m Tx) -> m Tx
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
forall (m :: * -> *).
MonadThrow m =>
TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
finalizeTx TinyWallet m
wallet ChainContext
ctx UTxO
spendableUTxO UTxO
forall a. Monoid a => a
mempty
          FinalPartialFanoutTx{UTxOType Tx
utxoToDistribute :: UTxOType Tx
$sel:utxoToDistribute:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxoToDistribute, UTxOType Tx
presettledUTxO :: UTxOType Tx
$sel:presettledUTxO:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
presettledUTxO, HeadSeed
$sel:headSeed:InitTx :: forall tx. PostChainTx tx -> HeadSeed
headSeed :: HeadSeed
headSeed, UTCTime
$sel:contestationDeadline:InitTx :: forall tx. PostChainTx tx -> UTCTime
contestationDeadline :: UTCTime
contestationDeadline} -> do
            (SlotNo
deadlineSlot, TxIn
seedTxIn) <- HeadSeed -> UTCTime -> m (SlotNo, TxIn)
resolveHeadInfo HeadSeed
headSeed UTCTime
contestationDeadline
            Tracer m CardanoChainLog
-> TinyWallet m
-> ChainContext
-> UTxO
-> TxIn
-> Maybe Tx
-> UTxO
-> UTxO
-> Int
-> SlotNo
-> m Tx
forall (m :: * -> *).
MonadThrow m =>
Tracer m CardanoChainLog
-> TinyWallet m
-> ChainContext
-> UTxO
-> TxIn
-> Maybe Tx
-> UTxO
-> UTxO
-> Int
-> SlotNo
-> m Tx
findFittingFanoutTx
              Tracer m CardanoChainLog
tracer
              TinyWallet m
wallet
              ChainContext
ctx
              UTxO
spendableUTxO
              TxIn
seedTxIn
              (Either PartialFanoutError Tx -> Maybe Tx
forall l r. Either l r -> Maybe r
rightToMaybe (ChainContext
-> UTxO
-> TxIn
-> UTxO
-> UTxO
-> SlotNo
-> Either PartialFanoutError Tx
finalPartialFanout ChainContext
ctx UTxO
spendableUTxO TxIn
seedTxIn UTxOType Tx
UTxO
utxoToDistribute UTxOType Tx
UTxO
presettledUTxO SlotNo
deadlineSlot))
              (UTxOType Tx
UTxO
utxoToDistribute UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxOType Tx
UTxO
presettledUTxO)
              UTxOType Tx
UTxO
utxoToDistribute
              (UTxO -> Int
forall era. UTxO era -> Int
UTxO.size UTxOType Tx
UTxO
utxoToDistribute Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              SlotNo
deadlineSlot
              m Tx -> (Tx -> m Tx) -> m Tx
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
forall (m :: * -> *).
MonadThrow m =>
TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
finalizeTx TinyWallet m
wallet ChainContext
ctx UTxO
spendableUTxO UTxO
forall a. Monoid a => a
mempty
          PartialFanoutTx{UTxOType Tx
$sel:utxoToDistribute:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxoToDistribute :: UTxOType Tx
utxoToDistribute, UTxOType Tx
$sel:utxoForProof:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxoForProof :: UTxOType Tx
utxoForProof, HeadSeed
$sel:headSeed:InitTx :: forall tx. PostChainTx tx -> HeadSeed
headSeed :: HeadSeed
headSeed, UTCTime
$sel:contestationDeadline:InitTx :: forall tx. PostChainTx tx -> UTCTime
contestationDeadline :: UTCTime
contestationDeadline} -> do
            (SlotNo
deadlineSlot, TxIn
seedTxIn) <- HeadSeed -> UTCTime -> m (SlotNo, TxIn)
resolveHeadInfo HeadSeed
headSeed UTCTime
contestationDeadline
            -- Non-final partial fanout: no preferred tx, always chunk from the
            -- user-selected set. The whole selection may be distributed in one
            -- tx (size, not size-1): the selection is always a strict subset of
            -- the head's remaining UTxO (HeadLogic routes a full selection to
            -- the final/auto path instead), so the unselected remainder stays in
            -- the accumulator and 'mustNotBeLastBatch' is satisfied regardless of
            -- chunk size.
            Tracer m CardanoChainLog
-> TinyWallet m
-> ChainContext
-> UTxO
-> TxIn
-> Maybe Tx
-> UTxO
-> UTxO
-> Int
-> SlotNo
-> m Tx
forall (m :: * -> *).
MonadThrow m =>
Tracer m CardanoChainLog
-> TinyWallet m
-> ChainContext
-> UTxO
-> TxIn
-> Maybe Tx
-> UTxO
-> UTxO
-> Int
-> SlotNo
-> m Tx
findFittingFanoutTx
              Tracer m CardanoChainLog
tracer
              TinyWallet m
wallet
              ChainContext
ctx
              UTxO
spendableUTxO
              TxIn
seedTxIn
              Maybe Tx
forall a. Maybe a
Nothing
              UTxOType Tx
UTxO
utxoForProof
              UTxOType Tx
UTxO
utxoToDistribute
              (UTxO -> Int
forall era. UTxO era -> Int
UTxO.size UTxOType Tx
UTxO
utxoToDistribute)
              SlotNo
deadlineSlot
              m Tx -> (Tx -> m Tx) -> m Tx
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
forall (m :: * -> *).
MonadThrow m =>
TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
finalizeTx TinyWallet m
wallet ChainContext
ctx UTxO
spendableUTxO UTxO
forall a. Monoid a => a
mempty
          InitTx{[OnChainId]
participants :: [OnChainId]
$sel:participants:InitTx :: forall tx. PostChainTx tx -> [OnChainId]
participants, HeadParameters
headParameters :: HeadParameters
$sel:headParameters:InitTx :: forall tx. PostChainTx tx -> HeadParameters
headParameters} -> do
            TxIn
seedInput <-
              STM m TxIn -> m TxIn
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m TxIn -> m TxIn) -> STM m TxIn -> m TxIn
forall a b. (a -> b) -> a -> b
$
                TinyWallet m -> STM m (Maybe TxIn)
forall (m :: * -> *). TinyWallet m -> STM m (Maybe TxIn)
getSeedInput TinyWallet m
wallet STM m (Maybe TxIn) -> (Maybe TxIn -> STM m TxIn) -> STM m TxIn
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM m TxIn -> (TxIn -> STM m TxIn) -> Maybe TxIn -> STM m TxIn
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PostTxError Tx -> STM m TxIn
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall tx. PostTxError tx
NoSeedInput @Tx)) TxIn -> STM m TxIn
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            PParams ConwayEra
pparams <- TinyWallet m -> m (PParams LedgerEra)
forall (m :: * -> *). TinyWallet m -> m (PParams LedgerEra)
getPParams TinyWallet m
wallet
            TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
forall (m :: * -> *).
MonadThrow m =>
TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
finalizeTx TinyWallet m
wallet ChainContext
ctx UTxO
spendableUTxO UTxO
forall a. Monoid a => a
mempty (Tx -> m Tx) -> Tx -> m Tx
forall a b. (a -> b) -> a -> b
$
              ChainContext
-> PParams LedgerEra -> TxIn -> [OnChainId] -> HeadParameters -> Tx
initialize ChainContext
ctx PParams ConwayEra
PParams LedgerEra
pparams TxIn
seedInput [OnChainId]
participants HeadParameters
headParameters
          PostChainTx Tx
_ ->
            STM m Tx -> m Tx
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TimeHandle
-> ChainContext -> UTxOType Tx -> PostChainTx Tx -> STM m Tx
forall (m :: * -> *).
(MonadSTM m, MonadThrow (STM m)) =>
TimeHandle
-> ChainContext -> UTxOType Tx -> PostChainTx Tx -> STM m Tx
prepareTxToPost TimeHandle
timeHandle ChainContext
ctx UTxOType Tx
UTxO
spendableUTxO PostChainTx Tx
tx)
              m Tx -> (Tx -> m Tx) -> m Tx
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
forall (m :: * -> *).
MonadThrow m =>
TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
finalizeTx TinyWallet m
wallet ChainContext
ctx UTxO
spendableUTxO UTxO
forall a. Monoid a => a
mempty
        SubmitTx m
submitTx Tx
vtx
    , $sel:draftDepositTx:Chain :: MonadThrow m =>
HeadId
-> PParams LedgerEra
-> ConfirmedSnapshot Tx
-> CommitBlueprintTx Tx
-> UTCTime
-> Maybe AddressInEra
-> m (Either (PostTxError Tx) Tx)
draftDepositTx = \HeadId
headId PParams LedgerEra
pparams ConfirmedSnapshot Tx
currentSnapshot CommitBlueprintTx Tx
commitBlueprintTx UTCTime
deadline Maybe AddressInEra
changeAddress -> do
        let CommitBlueprintTx{UTxOType Tx
lookupUTxO :: UTxOType Tx
$sel:lookupUTxO:CommitBlueprintTx :: forall tx. CommitBlueprintTx tx -> UTxOType tx
lookupUTxO} = CommitBlueprintTx Tx
commitBlueprintTx
        ChainStateAt{UTxO
$sel:spendableUTxO:ChainStateAt :: ChainStateAt -> UTxO
spendableUTxO :: UTxO
spendableUTxO} <- STM m ChainStateAt -> m ChainStateAt
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (ChainStateType Tx)
STM m ChainStateAt
getLatest
        TimeHandle{Either Text PointInTime
currentPointInTime :: Either Text PointInTime
$sel:currentPointInTime:TimeHandle :: TimeHandle -> Either Text PointInTime
currentPointInTime} <- GetTimeHandle m
queryTimeHandle
        -- XXX: What an error handling mess
        ExceptT (PostTxError Tx) m Tx -> m (Either (PostTxError Tx) Tx)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (PostTxError Tx) m Tx -> m (Either (PostTxError Tx) Tx))
-> ExceptT (PostTxError Tx) m Tx -> m (Either (PostTxError Tx) Tx)
forall a b. (a -> b) -> a -> b
$
          do
            Either (PostTxError Tx) () -> ExceptT (PostTxError Tx) m ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either (PostTxError Tx) () -> ExceptT (PostTxError Tx) m ())
-> Either (PostTxError Tx) () -> ExceptT (PostTxError Tx) m ()
forall a b. (a -> b) -> a -> b
$ do
              UTxO -> Either (PostTxError Tx) ()
rejectByronAddresses UTxOType Tx
UTxO
lookupUTxO
              PParams LedgerEra -> UTxO -> Either (PostTxError Tx) ()
rejectLowDeposits PParams LedgerEra
pparams UTxOType Tx
UTxO
lookupUTxO
            (SlotNo
currentSlot, UTCTime
currentTime) <- case Either Text PointInTime
currentPointInTime of
              Left Text
failureReason -> PostTxError Tx -> ExceptT (PostTxError Tx) m PointInTime
forall a. PostTxError Tx -> ExceptT (PostTxError Tx) m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FailedToConstructDepositTx{Text
$sel:failureReason:NoSeedInput :: Text
failureReason :: Text
failureReason}
              Right (SlotNo
s, UTCTime
t) -> PointInTime -> ExceptT (PostTxError Tx) m PointInTime
forall a. a -> ExceptT (PostTxError Tx) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
s, UTCTime
t)
            -- NOTE: Use a smaller upper bound than maxGraceTime to allow for
            -- shorter than 200 slot deposit periods. This is only important on
            -- fast moving networks (e.g. in testing). XXX: Making maxGraceTime
            -- configurable would avoid this.
            let untilDeadline :: NominalDiffTime
untilDeadline = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline UTCTime
currentTime
            let graceTime :: NominalDiffTime
graceTime = NominalDiffTime
maxGraceTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
`min` NominalDiffTime
untilDeadline NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
2
            -- -- NOTE: But also not make it smaller than 10 slots.
            let validBeforeSlot :: SlotNo
validBeforeSlot = SlotNo
currentSlot SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ Integer -> SlotNo
forall a. Num a => Integer -> a
fromInteger (NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate NominalDiffTime
graceTime Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`max` Integer
10)
            let depositDraftTx :: Tx
depositDraftTx = HasCallStack =>
NetworkId
-> PParams LedgerEra
-> HeadId
-> CommitBlueprintTx Tx
-> SlotNo
-> UTCTime
-> Maybe AddressInEra
-> Tx
NetworkId
-> PParams LedgerEra
-> HeadId
-> CommitBlueprintTx Tx
-> SlotNo
-> UTCTime
-> Maybe AddressInEra
-> Tx
depositTx (ChainContext -> NetworkId
networkId ChainContext
ctx) PParams LedgerEra
pparams HeadId
headId CommitBlueprintTx Tx
commitBlueprintTx SlotNo
validBeforeSlot UTCTime
deadline Maybe AddressInEra
changeAddress
            PParams ConwayEra
l1PParams <- m (PParams ConwayEra)
-> ExceptT (PostTxError Tx) m (PParams ConwayEra)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (PostTxError Tx) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (PParams ConwayEra)
 -> ExceptT (PostTxError Tx) m (PParams ConwayEra))
-> m (PParams ConwayEra)
-> ExceptT (PostTxError Tx) m (PParams ConwayEra)
forall a b. (a -> b) -> a -> b
$ TinyWallet m -> m (PParams LedgerEra)
forall (m :: * -> *). TinyWallet m -> m (PParams LedgerEra)
getPParams TinyWallet m
wallet
            Either (PostTxError Tx) () -> ExceptT (PostTxError Tx) m ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either (PostTxError Tx) () -> ExceptT (PostTxError Tx) m ())
-> Either (PostTxError Tx) () -> ExceptT (PostTxError Tx) m ()
forall a b. (a -> b) -> a -> b
$ PParams LedgerEra
-> ChainContext
-> UTxO
-> HeadId
-> ConfirmedSnapshot Tx
-> Tx
-> SlotNo
-> Either (PostTxError Tx) ()
rejectOversizedDeposit PParams ConwayEra
PParams LedgerEra
l1PParams ChainContext
ctx UTxO
spendableUTxO HeadId
headId ConfirmedSnapshot Tx
currentSnapshot Tx
depositDraftTx SlotNo
validBeforeSlot
            m Tx -> ExceptT (PostTxError Tx) m Tx
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (PostTxError Tx) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Tx -> ExceptT (PostTxError Tx) m Tx)
-> m Tx -> ExceptT (PostTxError Tx) m Tx
forall a b. (a -> b) -> a -> b
$ TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
forall (m :: * -> *).
MonadThrow m =>
TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
finalizeTx TinyWallet m
wallet ChainContext
ctx UTxO
spendableUTxO UTxOType Tx
UTxO
lookupUTxO Tx
depositDraftTx
    , -- Submit a cardano transaction to the cardano-node using the
      -- LocalTxSubmission protocol.
      MonadThrow m => SubmitTx m
SubmitTx m
submitTx :: SubmitTx m
$sel:submitTx:Chain :: MonadThrow m => SubmitTx m
submitTx
    , $sel:checkNonADAAssets:Chain :: ConfirmedSnapshot Tx -> Either Value ()
checkNonADAAssets = UTxO -> Either Value ()
checkNonADAAssetsUTxO (UTxO -> Either Value ())
-> (ConfirmedSnapshot Tx -> UTxO)
-> ConfirmedSnapshot Tx
-> Either Value ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snapshot Tx -> UTxOType Tx
Snapshot Tx -> UTxO
forall tx. IsTx tx => Snapshot tx -> UTxOType tx
snapshotUTxO (Snapshot Tx -> UTxO)
-> (ConfirmedSnapshot Tx -> Snapshot Tx)
-> ConfirmedSnapshot Tx
-> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmedSnapshot Tx -> Snapshot Tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot
    }

-- Check each UTxO entry against the minADAUTxO value.
-- Throws 'DepositTooLow' exception.
rejectLowDeposits :: PParams LedgerEra -> UTxO -> Either (PostTxError Tx) ()
rejectLowDeposits :: PParams LedgerEra -> UTxO -> Either (PostTxError Tx) ()
rejectLowDeposits PParams LedgerEra
pparams UTxO
utxo =
  -- The provided and minimum values both derive from the same output, so we can
  -- compare them in a single pass over the UTxO.
  [(TxIn, TxOut CtxUTxO Era)]
-> ((TxIn, TxOut CtxUTxO Era) -> Either (PostTxError Tx) ())
-> Either (PostTxError Tx) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (UTxO -> [(TxIn, TxOut CtxUTxO Era)]
forall era. UTxO era -> [(TxIn, TxOut CtxUTxO era)]
UTxO.toList UTxO
utxo) (((TxIn, TxOut CtxUTxO Era) -> Either (PostTxError Tx) ())
 -> Either (PostTxError Tx) ())
-> ((TxIn, TxOut CtxUTxO Era) -> Either (PostTxError Tx) ())
-> Either (PostTxError Tx) ()
forall a b. (a -> b) -> a -> b
$ \(TxIn
i, TxOut CtxUTxO Era
o) -> do
    let providedValue :: Coin
providedValue = UTxO -> Coin
forall era. UTxO era -> Coin
UTxO.totalLovelace (UTxO -> Coin) -> UTxO -> Coin
forall a b. (a -> b) -> a -> b
$ TxIn -> TxOut CtxUTxO Era -> UTxO
forall era. TxIn -> TxOut CtxUTxO era -> UTxO era
UTxO.singleton TxIn
i TxOut CtxUTxO Era
o
        minimumValue :: Coin
minimumValue = ShelleyBasedEra Era -> PParams LedgerEra -> TxOut CtxTx Era -> Coin
forall era.
HasCallStack =>
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> TxOut CtxTx era -> Coin
calculateMinimumUTxO ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra PParams LedgerEra
pparams (TxOut CtxTx Era -> Coin) -> TxOut CtxTx Era -> Coin
forall a b. (a -> b) -> a -> b
$ TxOut CtxUTxO Era -> TxOut CtxTx Era
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
fromCtxUTxOTxOut TxOut CtxUTxO Era
o
    Bool -> Either (PostTxError Tx) () -> Either (PostTxError Tx) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Coin
providedValue Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
minimumValue) (Either (PostTxError Tx) () -> Either (PostTxError Tx) ())
-> Either (PostTxError Tx) () -> Either (PostTxError Tx) ()
forall a b. (a -> b) -> a -> b
$
      PostTxError Tx -> Either (PostTxError Tx) ()
forall a b. a -> Either a b
Left (DepositTooLow{Coin
providedValue :: Coin
$sel:providedValue:NoSeedInput :: Coin
providedValue, Coin
minimumValue :: Coin
$sel:minimumValue:NoSeedInput :: Coin
minimumValue} :: PostTxError Tx)

-- | Reject any UTxO containing a Byron address, which cannot be represented
-- in the Hydra head protocol.
rejectByronAddresses :: UTxO -> Either (PostTxError Tx) ()
rejectByronAddresses :: UTxO -> Either (PostTxError Tx) ()
rejectByronAddresses UTxO
utxo =
  case ((TxIn, TxOut CtxUTxO Era) -> [Address ByronAddr])
-> [(TxIn, TxOut CtxUTxO Era)] -> [Address ByronAddr]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TxIn, TxOut CtxUTxO Era) -> [Address ByronAddr]
forall a era. (a, TxOut era) -> [Address ByronAddr]
toByronAddr (UTxO -> [(TxIn, TxOut CtxUTxO Era)]
forall era. UTxO era -> [(TxIn, TxOut CtxUTxO era)]
UTxO.toList UTxO
utxo) of
    (Address ByronAddr
addr : [Address ByronAddr]
_) -> PostTxError Tx -> Either (PostTxError Tx) ()
forall a b. a -> Either a b
Left (Address ByronAddr -> PostTxError Tx
forall tx. Address ByronAddr -> PostTxError tx
UnsupportedLegacyOutput Address ByronAddr
addr)
    [] -> () -> Either (PostTxError Tx) ()
forall a b. b -> Either a b
Right ()
 where
  toByronAddr :: forall a era. (a, TxOut era) -> [Address ByronAddr]
  toByronAddr :: forall a era. (a, TxOut era) -> [Address ByronAddr]
toByronAddr (a
_, TxOut era
out) = case TxOut era -> AddressInEra
forall ctx. TxOut ctx -> AddressInEra
txOutAddress TxOut era
out of
    ByronAddressInEra Address ByronAddr
addr -> [Address ByronAddr
addr]
    AddressInEra
_ -> []

-- | Reject deposits which could never be claimed: builds a dry-run increment
-- transaction for the drafted deposit and rejects with 'DepositTooLarge' when
-- it would violate layer 1 ledger limits - the maximum transaction size, or
-- the maximum serialized value size of the merged head output.
rejectOversizedDeposit ::
  -- | Layer 1 protocol parameters (from 'getPParams' of the wallet, NOT the L2
  -- ledger parameters passed to the draft endpoint).
  PParams LedgerEra ->
  ChainContext ->
  -- | Spendable UTxO containing the current head output.
  UTxO ->
  HeadId ->
  -- | Current confirmed snapshot, basis for the dry-run increment.
  ConfirmedSnapshot Tx ->
  -- | Drafted (unbalanced) deposit transaction.
  Tx ->
  -- | Upper validity slot for the dry-run increment.
  SlotNo ->
  Either (PostTxError Tx) ()
rejectOversizedDeposit :: PParams LedgerEra
-> ChainContext
-> UTxO
-> HeadId
-> ConfirmedSnapshot Tx
-> Tx
-> SlotNo
-> Either (PostTxError Tx) ()
rejectOversizedDeposit PParams LedgerEra
pparams ChainContext
ctx UTxO
spendableUTxO HeadId
headId ConfirmedSnapshot Tx
currentSnapshot Tx
depositDraftTx SlotNo
upperValiditySlot = do
  Tx
dryRunTx <-
    (IncrementTxError -> PostTxError Tx)
-> Either IncrementTxError Tx -> Either (PostTxError Tx) Tx
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      (\IncrementTxError
err -> FailedToConstructDepositTx{$sel:failureReason:NoSeedInput :: Text
failureReason = Text
"increment dry-run: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IncrementTxError -> Text
forall b a. (Show a, IsString b) => a -> b
show IncrementTxError
err})
      (ChainContext
-> UTxO
-> HeadId
-> ConfirmedSnapshot Tx
-> Tx
-> SlotNo
-> Either IncrementTxError Tx
dryRunIncrementTx ChainContext
ctx UTxO
spendableUTxO HeadId
headId ConfirmedSnapshot Tx
currentSnapshot Tx
depositDraftTx SlotNo
upperValiditySlot)
  let estimatedTxSize :: Natural
estimatedTxSize = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length (Tx -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Tx
dryRunTx)) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
incrementTxBalancingMargin
      maximumTxSize :: Natural
maximumTxSize = Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams ConwayEra
PParams LedgerEra
pparams PParams ConwayEra
-> Getting Word32 (PParams ConwayEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams ConwayEra) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ConwayEra) Word32
ppMaxTxSizeL)
      -- The dry-run increment has exactly one output: the merged head output.
      estimatedValueSize :: Natural
estimatedValueSize = (TxOut CtxTx Era -> Natural -> Natural)
-> Natural -> [TxOut CtxTx Era] -> Natural
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max (Natural -> Natural -> Natural)
-> (TxOut CtxTx Era -> Natural)
-> TxOut CtxTx Era
-> Natural
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams LedgerEra -> Value -> Natural
serializedValueSize PParams LedgerEra
pparams (Value -> Natural)
-> (TxOut CtxTx Era -> Value) -> TxOut CtxTx Era -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue) Natural
0 (Tx -> [TxOut CtxTx Era]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
dryRunTx)
      maximumValueSize :: Natural
maximumValueSize = Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams ConwayEra
PParams LedgerEra
pparams PParams ConwayEra
-> Getting Word32 (PParams ConwayEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams ConwayEra) Word32
forall era. AlonzoEraPParams era => Lens' (PParams era) Word32
Lens' (PParams ConwayEra) Word32
ppMaxValSizeL)
  Bool -> Either (PostTxError Tx) () -> Either (PostTxError Tx) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
estimatedTxSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
maximumTxSize Bool -> Bool -> Bool
|| Natural
estimatedValueSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
maximumValueSize) (Either (PostTxError Tx) () -> Either (PostTxError Tx) ())
-> Either (PostTxError Tx) () -> Either (PostTxError Tx) ()
forall a b. (a -> b) -> a -> b
$
    PostTxError Tx -> Either (PostTxError Tx) ()
forall a b. a -> Either a b
Left DepositTooLarge{Natural
estimatedTxSize :: Natural
$sel:estimatedTxSize:NoSeedInput :: Natural
estimatedTxSize, Natural
maximumTxSize :: Natural
$sel:maximumTxSize:NoSeedInput :: Natural
maximumTxSize, Natural
estimatedValueSize :: Natural
$sel:estimatedValueSize:NoSeedInput :: Natural
estimatedValueSize, Natural
maximumValueSize :: Natural
$sel:maximumValueSize:NoSeedInput :: Natural
maximumValueSize}

-- | Serialized size of a value, computed exactly like the ledger's
-- OutputTooBigUTxO check. NOTE: Keep in sync with
-- 'Cardano.Ledger.Alonzo.Rules.validateOutputTooBigUTxO'.
serializedValueSize :: PParams LedgerEra -> Value -> Natural
serializedValueSize :: PParams LedgerEra -> Value -> Natural
serializedValueSize PParams LedgerEra
pparams =
  Int64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Natural) -> (Value -> Int64) -> Value -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length (ByteString -> Int64) -> (Value -> ByteString) -> Value -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> MaryValue -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize (ProtVer -> Version
pvMajor (PParams ConwayEra
PParams LedgerEra
pparams PParams ConwayEra
-> Getting ProtVer (PParams ConwayEra) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams ConwayEra) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams ConwayEra) ProtVer
ppProtocolVersionL)) (MaryValue -> ByteString)
-> (Value -> MaryValue) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> MaryValue
toLedgerValue

-- | Byte headroom added to the unbalanced dry-run increment transaction when
-- comparing against the maximum transaction size, covering what 'coverFee' and
-- 'sign' add to the real increment: a fee input (~40 bytes), a collateral
-- input (~40 bytes), an ada-only change output (~70 bytes), the script
-- integrity hash (~37 bytes), the fee field (~5 bytes), one key witness (~102
-- bytes), and wider integer encodings for the estimated execution units,
-- snapshot number and validity slot (~40 bytes) - around 334 bytes in total.
-- We add some overhead and use 512 just to be more safe.
incrementTxBalancingMargin :: Natural
incrementTxBalancingMargin :: Natural
incrementTxBalancingMargin = Natural
512

-- | Balance and sign the given partial transaction.
finalizeTx ::
  MonadThrow m =>
  TinyWallet m ->
  ChainContext ->
  UTxO ->
  UTxO ->
  Tx ->
  m Tx
finalizeTx :: forall (m :: * -> *).
MonadThrow m =>
TinyWallet m -> ChainContext -> UTxO -> UTxO -> Tx -> m Tx
finalizeTx TinyWallet{Tx -> Tx
sign :: forall (m :: * -> *). TinyWallet m -> Tx -> Tx
sign :: Tx -> Tx
sign, UTxO -> Tx -> m (Either ErrCoverFee Tx)
coverFee :: forall (m :: * -> *).
TinyWallet m -> UTxO -> Tx -> m (Either ErrCoverFee Tx)
coverFee :: UTxO -> Tx -> m (Either ErrCoverFee Tx)
coverFee} ChainContext
ctx UTxO
utxo UTxO
userUTxO Tx
partialTx = do
  let headUTxO :: UTxO
headUTxO = ChainContext -> UTxO
forall a. HasKnownUTxO a => a -> UTxO
getKnownUTxO ChainContext
ctx UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
utxo UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
userUTxO
  UTxO -> Tx -> m (Either ErrCoverFee Tx)
coverFee UTxO
headUTxO Tx
partialTx m (Either ErrCoverFee Tx)
-> (Either ErrCoverFee Tx -> m Tx) -> m Tx
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ErrCoverFee
ErrNoFuelUTxOFound ->
      PostTxError Tx -> m Tx
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO NoFuelUTXOFound{$sel:failingTx:NoSeedInput :: Tx
failingTx = Tx
partialTx}
    Left ErrNotEnoughFunds{} ->
      PostTxError Tx -> m Tx
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO NotEnoughFuel{$sel:failingTx:NoSeedInput :: Tx
failingTx = Tx
partialTx}
    Left ErrScriptExecutionFailed{Text
redeemerPointer :: Text
$sel:redeemerPointer:ErrNotEnoughFunds :: ErrCoverFee -> Text
redeemerPointer, Text
scriptFailure :: Text
$sel:scriptFailure:ErrNotEnoughFunds :: ErrCoverFee -> Text
scriptFailure} ->
      PostTxError Tx -> m Tx
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
        ( ScriptFailedInWallet
            { $sel:redeemerPtr:NoSeedInput :: Text
redeemerPtr = Text
redeemerPointer
            , $sel:failureReason:NoSeedInput :: Text
failureReason = Text
scriptFailure
            , $sel:failingTx:NoSeedInput :: Tx
failingTx = Tx
partialTx
            } ::
            PostTxError Tx
        )
    Left ErrMissingScript{Text
scriptHash :: Text
$sel:scriptHash:ErrNotEnoughFunds :: ErrCoverFee -> Text
scriptHash, Text
purpose :: Text
$sel:purpose:ErrNotEnoughFunds :: ErrCoverFee -> Text
purpose} ->
      PostTxError Tx -> m Tx
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
        ( ScriptFailedInWallet
            { $sel:redeemerPtr:NoSeedInput :: Text
redeemerPtr = Text
purpose
            , $sel:failureReason:NoSeedInput :: Text
failureReason = Text
"Missing script witness for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
scriptHash
            , $sel:failingTx:NoSeedInput :: Tx
failingTx = Tx
partialTx
            } ::
            PostTxError Tx
        )
    Left ErrCoverFee
e ->
      PostTxError Tx -> m Tx
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
        ( InternalWalletError
            { UTxOType Tx
UTxO
headUTxO :: UTxO
$sel:headUTxO:NoSeedInput :: UTxOType Tx
headUTxO
            , $sel:reason:NoSeedInput :: Text
reason = ErrCoverFee -> Text
forall b a. (Show a, IsString b) => a -> b
show ErrCoverFee
e
            , $sel:failingTx:NoSeedInput :: Tx
failingTx = Tx
partialTx
            } ::
            PostTxError Tx
        )
    Right Tx
balancedTx ->
      Tx -> m Tx
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> m Tx) -> Tx -> m Tx
forall a b. (a -> b) -> a -> b
$ Tx -> Tx
sign Tx
balancedTx

-- * Following the Chain

-- | A /handler/ that takes care of following the chain.
data ChainSyncHandler m = ChainSyncHandler
  { forall (m :: * -> *).
ChainSyncHandler m -> BlockHeader -> [Tx] -> m ()
onRollForward :: BlockHeader -> [Tx] -> m ()
  , forall (m :: * -> *). ChainSyncHandler m -> ChainPoint -> m ()
onRollBackward :: ChainPoint -> m ()
  }

-- | Conversion of a slot number to a time failed. This can be usually be
-- considered an internal error and may be happening because the used era
-- history is too old.
data TimeConversionException = TimeConversionException
  { TimeConversionException -> SlotNo
slotNo :: SlotNo
  , TimeConversionException -> Text
reason :: Text
  }
  deriving stock (TimeConversionException -> TimeConversionException -> Bool
(TimeConversionException -> TimeConversionException -> Bool)
-> (TimeConversionException -> TimeConversionException -> Bool)
-> Eq TimeConversionException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeConversionException -> TimeConversionException -> Bool
== :: TimeConversionException -> TimeConversionException -> Bool
$c/= :: TimeConversionException -> TimeConversionException -> Bool
/= :: TimeConversionException -> TimeConversionException -> Bool
Eq, Int -> TimeConversionException -> ShowS
[TimeConversionException] -> ShowS
TimeConversionException -> String
(Int -> TimeConversionException -> ShowS)
-> (TimeConversionException -> String)
-> ([TimeConversionException] -> ShowS)
-> Show TimeConversionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeConversionException -> ShowS
showsPrec :: Int -> TimeConversionException -> ShowS
$cshow :: TimeConversionException -> String
show :: TimeConversionException -> String
$cshowList :: [TimeConversionException] -> ShowS
showList :: [TimeConversionException] -> ShowS
Show)
  deriving anyclass (Show TimeConversionException
Typeable TimeConversionException
(Typeable TimeConversionException, Show TimeConversionException) =>
(TimeConversionException -> SomeException)
-> (SomeException -> Maybe TimeConversionException)
-> (TimeConversionException -> String)
-> Exception TimeConversionException
SomeException -> Maybe TimeConversionException
TimeConversionException -> String
TimeConversionException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: TimeConversionException -> SomeException
toException :: TimeConversionException -> SomeException
$cfromException :: SomeException -> Maybe TimeConversionException
fromException :: SomeException -> Maybe TimeConversionException
$cdisplayException :: TimeConversionException -> String
displayException :: TimeConversionException -> String
Exception)

-- | Creates a `ChainSyncHandler` that can notify the given `callback` of events happening
-- on-chain.
--
-- This forms the other half of a `ChainComponent` along with `mkChain` but is decoupled from
-- actual interactions with the chain.
--
-- A `TimeHandle` is needed to do `SlotNo -> POSIXTime` conversions for 'Tick' events.
--
-- Throws 'TimeConversionException' when a received block's 'SlotNo' cannot be
-- converted to a 'UTCTime' with the given 'TimeHandle'.
chainSyncHandler ::
  forall m.
  (MonadSTM m, MonadThrow m) =>
  -- | Tracer for logging
  Tracer m CardanoChainLog ->
  ChainCallback Tx m ->
  -- | Means to acquire a 'TimeHandle' able to convert the given slot.
  (SlotNo -> GetTimeHandle m) ->
  -- | Contextual information about our chain connection.
  ChainContext ->
  LocalChainState m Tx ->
  -- | A chain-sync handler to use in a local-chain-sync client.
  ChainSyncHandler m
chainSyncHandler :: forall (m :: * -> *).
(MonadSTM m, MonadThrow m) =>
Tracer m CardanoChainLog
-> ChainCallback Tx m
-> (SlotNo -> GetTimeHandle m)
-> ChainContext
-> LocalChainState m Tx
-> ChainSyncHandler m
chainSyncHandler Tracer m CardanoChainLog
tracer ChainCallback Tx m
callback SlotNo -> GetTimeHandle m
getTimeHandle ChainContext
ctx LocalChainState m Tx
localChainState =
  ChainSyncHandler
    { ChainPoint -> m ()
$sel:onRollBackward:ChainSyncHandler :: ChainPoint -> m ()
onRollBackward :: ChainPoint -> m ()
onRollBackward
    , BlockHeader -> [Tx] -> m ()
$sel:onRollForward:ChainSyncHandler :: BlockHeader -> [Tx] -> m ()
onRollForward :: BlockHeader -> [Tx] -> m ()
onRollForward
    }
 where
  ChainContext{NetworkId
$sel:networkId:ChainContext :: ChainContext -> NetworkId
networkId :: NetworkId
networkId} = ChainContext
ctx
  LocalChainState{ChainSlot -> STM m (ChainStateType Tx)
$sel:rollback:LocalChainState :: forall (m :: * -> *) tx.
LocalChainState m tx -> ChainSlot -> STM m (ChainStateType tx)
rollback :: ChainSlot -> STM m (ChainStateType Tx)
rollback, STM m (ChainStateType Tx)
$sel:getLatest:LocalChainState :: forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateType tx)
getLatest :: STM m (ChainStateType Tx)
getLatest, ChainStateType Tx -> STM m ()
$sel:pushNew:LocalChainState :: forall (m :: * -> *) tx.
LocalChainState m tx -> ChainStateType tx -> STM m ()
pushNew :: ChainStateType Tx -> STM m ()
pushNew} = LocalChainState m Tx
localChainState

  onRollBackward :: ChainPoint -> m ()
  onRollBackward :: ChainPoint -> m ()
onRollBackward ChainPoint
point = do
    Tracer m CardanoChainLog -> CardanoChainLog -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m CardanoChainLog
tracer (CardanoChainLog -> m ()) -> CardanoChainLog -> m ()
forall a b. (a -> b) -> a -> b
$ RolledBackward{ChainPoint
point :: ChainPoint
$sel:point:ToPost :: ChainPoint
point}
    let slotNo :: SlotNo
slotNo = SlotNo -> Maybe SlotNo -> SlotNo
forall a. a -> Maybe a -> a
fromMaybe SlotNo
0 (ChainPoint -> Maybe SlotNo
chainPointToSlotNo ChainPoint
point)
    TimeHandle
timeHandle <- SlotNo -> GetTimeHandle m
getTimeHandle SlotNo
slotNo
    case TimeHandle -> SlotNo -> Either Text UTCTime
slotToUTCTime TimeHandle
timeHandle SlotNo
slotNo of
      Left Text
reason ->
        TimeConversionException -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO TimeConversionException{SlotNo
$sel:slotNo:TimeConversionException :: SlotNo
slotNo :: SlotNo
slotNo, Text
$sel:reason:TimeConversionException :: Text
reason :: Text
reason}
      Right UTCTime
utcTime -> do
        ChainStateAt
rolledBackChainState <- STM m ChainStateAt -> m ChainStateAt
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m ChainStateAt -> m ChainStateAt)
-> STM m ChainStateAt -> m ChainStateAt
forall a b. (a -> b) -> a -> b
$ ChainSlot -> STM m (ChainStateType Tx)
rollback (ChainPoint -> ChainSlot
chainSlotFromPoint ChainPoint
point)
        ChainCallback Tx m
callback Rollback{ChainStateType Tx
ChainStateAt
rolledBackChainState :: ChainStateAt
$sel:rolledBackChainState:Observation :: ChainStateType Tx
rolledBackChainState, $sel:chainTime:Observation :: UTCTime
chainTime = UTCTime
utcTime}

  onRollForward :: BlockHeader -> [Tx] -> m ()
  onRollForward :: BlockHeader -> [Tx] -> m ()
onRollForward BlockHeader
header [Tx]
receivedTxs = do
    let point :: ChainPoint
point = BlockHeader -> ChainPoint
getChainPoint BlockHeader
header
    Tracer m CardanoChainLog -> CardanoChainLog -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m CardanoChainLog
tracer (CardanoChainLog -> m ()) -> CardanoChainLog -> m ()
forall a b. (a -> b) -> a -> b
$
      RolledForward
        { ChainPoint
$sel:point:ToPost :: ChainPoint
point :: ChainPoint
point
        , $sel:receivedTxIds:ToPost :: [TxId]
receivedTxIds = TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId (TxBody Era -> TxId) -> (Tx -> TxBody Era) -> Tx -> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody (Tx -> TxId) -> [Tx] -> [TxId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx]
receivedTxs
        }

    TimeHandle
timeHandle <- SlotNo -> GetTimeHandle m
getTimeHandle (SlotNo -> GetTimeHandle m) -> SlotNo -> GetTimeHandle m
forall a b. (a -> b) -> a -> b
$ SlotNo -> Maybe SlotNo -> SlotNo
forall a. a -> Maybe a -> a
fromMaybe SlotNo
0 (ChainPoint -> Maybe SlotNo
chainPointToSlotNo ChainPoint
point)

    [Tx] -> (Tx -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Tx]
receivedTxs ((Tx -> m ()) -> m ()) -> (Tx -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
      TimeHandle -> ChainPoint -> Tx -> m (Maybe (ChainEvent Tx))
maybeObserveSomeTx TimeHandle
timeHandle ChainPoint
point (Tx -> m (Maybe (ChainEvent Tx)))
-> (Maybe (ChainEvent Tx) -> m ()) -> Tx -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
        Maybe (ChainEvent Tx)
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just ChainEvent Tx
event -> ChainCallback Tx m
callback ChainEvent Tx
event

    case ChainPoint -> Maybe SlotNo
chainPointToSlotNo ChainPoint
point of
      Maybe SlotNo
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just SlotNo
slotNo -> do
        case TimeHandle -> SlotNo -> Either Text UTCTime
slotToUTCTime TimeHandle
timeHandle SlotNo
slotNo of
          Left Text
reason ->
            TimeConversionException -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO TimeConversionException{SlotNo
$sel:slotNo:TimeConversionException :: SlotNo
slotNo :: SlotNo
slotNo, Text
$sel:reason:TimeConversionException :: Text
reason :: Text
reason}
          Right UTCTime
utcTime -> do
            ChainCallback Tx m
callback (Tick{$sel:chainTime:Observation :: UTCTime
chainTime = UTCTime
utcTime, $sel:chainPoint:Observation :: ChainPointType Tx
chainPoint = ChainPoint
ChainPointType Tx
point})

  maybeObserveSomeTx :: TimeHandle -> ChainPoint -> Tx -> m (Maybe (ChainEvent Tx))
maybeObserveSomeTx TimeHandle
timeHandle ChainPoint
point Tx
tx = STM m (Maybe (ChainEvent Tx)) -> m (Maybe (ChainEvent Tx))
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Maybe (ChainEvent Tx)) -> m (Maybe (ChainEvent Tx)))
-> STM m (Maybe (ChainEvent Tx)) -> m (Maybe (ChainEvent Tx))
forall a b. (a -> b) -> a -> b
$ do
    ChainStateAt{UTxO
$sel:spendableUTxO:ChainStateAt :: ChainStateAt -> UTxO
spendableUTxO :: UTxO
spendableUTxO} <- STM m (ChainStateType Tx)
STM m ChainStateAt
getLatest
    let observation :: HeadObservation
observation = NetworkId -> UTxO -> Tx -> HeadObservation
observeHeadTx NetworkId
networkId UTxO
spendableUTxO Tx
tx
    case TimeHandle -> HeadObservation -> Maybe (OnChainTx Tx)
convertObservation TimeHandle
timeHandle HeadObservation
observation of
      Maybe (OnChainTx Tx)
Nothing -> Maybe (ChainEvent Tx) -> STM m (Maybe (ChainEvent Tx))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ChainEvent Tx)
forall a. Maybe a
Nothing
      Just OnChainTx Tx
observedTx -> do
        let newChainState :: ChainStateAt
newChainState =
              ChainStateAt
                { $sel:spendableUTxO:ChainStateAt :: UTxO
spendableUTxO = Tx -> UTxO -> UTxO
adjustUTxO Tx
tx UTxO
spendableUTxO
                , $sel:recordedAt:ChainStateAt :: Maybe ChainPoint
recordedAt = ChainPoint -> Maybe ChainPoint
forall a. a -> Maybe a
Just ChainPoint
point
                }
        ChainStateType Tx -> STM m ()
pushNew ChainStateType Tx
ChainStateAt
newChainState
        Maybe (ChainEvent Tx) -> STM m (Maybe (ChainEvent Tx))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ChainEvent Tx) -> STM m (Maybe (ChainEvent Tx)))
-> Maybe (ChainEvent Tx) -> STM m (Maybe (ChainEvent Tx))
forall a b. (a -> b) -> a -> b
$ ChainEvent Tx -> Maybe (ChainEvent Tx)
forall a. a -> Maybe a
Just Observation{OnChainTx Tx
observedTx :: OnChainTx Tx
$sel:observedTx:Observation :: OnChainTx Tx
observedTx, ChainStateType Tx
ChainStateAt
newChainState :: ChainStateAt
$sel:newChainState:Observation :: ChainStateType Tx
newChainState}

convertObservation :: TimeHandle -> HeadObservation -> Maybe (OnChainTx Tx)
convertObservation :: TimeHandle -> HeadObservation -> Maybe (OnChainTx Tx)
convertObservation TimeHandle{SlotNo -> Either Text UTCTime
$sel:slotToUTCTime:TimeHandle :: TimeHandle -> SlotNo -> Either Text UTCTime
slotToUTCTime :: SlotNo -> Either Text UTCTime
slotToUTCTime} = \case
  HeadObservation
NoHeadTx -> Maybe (OnChainTx Tx)
forall a. Maybe a
Nothing
  Init InitObservation{HeadId
headId :: HeadId
$sel:headId:InitObservation :: InitObservation -> HeadId
headId, HeadSeed
headSeed :: HeadSeed
$sel:headSeed:InitObservation :: InitObservation -> HeadSeed
headSeed, HeadParameters
headParameters :: HeadParameters
$sel:headParameters:InitObservation :: InitObservation -> HeadParameters
headParameters, [OnChainId]
participants :: [OnChainId]
$sel:participants:InitObservation :: InitObservation -> [OnChainId]
participants} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnInitTx{HeadId
headId :: HeadId
$sel:headId:OnInitTx :: HeadId
headId, HeadSeed
headSeed :: HeadSeed
$sel:headSeed:OnInitTx :: HeadSeed
headSeed, HeadParameters
headParameters :: HeadParameters
$sel:headParameters:OnInitTx :: HeadParameters
headParameters, [OnChainId]
participants :: [OnChainId]
$sel:participants:OnInitTx :: [OnChainId]
participants}
  Deposit DepositObservation{HeadId
headId :: HeadId
$sel:headId:DepositObservation :: DepositObservation -> HeadId
headId, TxId
depositTxId :: TxId
$sel:depositTxId:DepositObservation :: DepositObservation -> TxId
depositTxId, UTxO
deposited :: UTxO
$sel:deposited:DepositObservation :: DepositObservation -> UTxO
deposited, SlotNo
created :: SlotNo
$sel:created:DepositObservation :: DepositObservation -> SlotNo
created, UTCTime
deadline :: UTCTime
$sel:deadline:DepositObservation :: DepositObservation -> UTCTime
deadline} -> do
    UTCTime
createdTime <- (Text -> Maybe UTCTime)
-> (UTCTime -> Maybe UTCTime)
-> Either Text UTCTime
-> Maybe UTCTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe UTCTime -> Text -> Maybe UTCTime
forall a b. a -> b -> a
const Maybe UTCTime
forall a. Maybe a
Nothing) UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (Either Text UTCTime -> Maybe UTCTime)
-> Either Text UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ SlotNo -> Either Text UTCTime
slotToUTCTime SlotNo
created
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OnChainTx Tx -> Maybe (OnChainTx Tx))
-> OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a b. (a -> b) -> a -> b
$ OnDepositTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, TxIdType Tx
TxId
depositTxId :: TxId
$sel:depositTxId:OnInitTx :: TxIdType Tx
depositTxId, UTxOType Tx
UTxO
deposited :: UTxO
$sel:deposited:OnInitTx :: UTxOType Tx
deposited, $sel:created:OnInitTx :: UTCTime
created = UTCTime
createdTime, UTCTime
deadline :: UTCTime
$sel:deadline:OnInitTx :: UTCTime
deadline}
  Recover RecoverObservation{HeadId
headId :: HeadId
$sel:headId:RecoverObservation :: RecoverObservation -> HeadId
headId, TxId
recoveredTxId :: TxId
$sel:recoveredTxId:RecoverObservation :: RecoverObservation -> TxId
recoveredTxId, UTxO
recoveredUTxO :: UTxO
$sel:recoveredUTxO:RecoverObservation :: RecoverObservation -> UTxO
recoveredUTxO} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnRecoverTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, TxIdType Tx
TxId
recoveredTxId :: TxId
$sel:recoveredTxId:OnInitTx :: TxIdType Tx
recoveredTxId, UTxOType Tx
UTxO
recoveredUTxO :: UTxO
$sel:recoveredUTxO:OnInitTx :: UTxOType Tx
recoveredUTxO}
  Increment IncrementObservation{HeadId
headId :: HeadId
$sel:headId:IncrementObservation :: IncrementObservation -> HeadId
headId, SnapshotVersion
newVersion :: SnapshotVersion
$sel:newVersion:IncrementObservation :: IncrementObservation -> SnapshotVersion
newVersion, TxId
depositTxId :: TxId
$sel:depositTxId:IncrementObservation :: IncrementObservation -> TxId
depositTxId} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnIncrementTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, SnapshotVersion
newVersion :: SnapshotVersion
$sel:newVersion:OnInitTx :: SnapshotVersion
newVersion, TxIdType Tx
TxId
$sel:depositTxId:OnInitTx :: TxIdType Tx
depositTxId :: TxId
depositTxId}
  Decrement DecrementObservation{HeadId
headId :: HeadId
$sel:headId:DecrementObservation :: DecrementObservation -> HeadId
headId, SnapshotVersion
newVersion :: SnapshotVersion
$sel:newVersion:DecrementObservation :: DecrementObservation -> SnapshotVersion
newVersion, UTxO
distributedUTxO :: UTxO
$sel:distributedUTxO:DecrementObservation :: DecrementObservation -> UTxO
distributedUTxO} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnDecrementTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, SnapshotVersion
$sel:newVersion:OnInitTx :: SnapshotVersion
newVersion :: SnapshotVersion
newVersion, UTxOType Tx
UTxO
distributedUTxO :: UTxO
$sel:distributedUTxO:OnInitTx :: UTxOType Tx
distributedUTxO}
  Close CloseObservation{HeadId
headId :: HeadId
$sel:headId:CloseObservation :: CloseObservation -> HeadId
headId, SnapshotNumber
snapshotNumber :: SnapshotNumber
$sel:snapshotNumber:CloseObservation :: CloseObservation -> SnapshotNumber
snapshotNumber, UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:CloseObservation :: CloseObservation -> UTCTime
contestationDeadline} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnCloseTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, SnapshotNumber
snapshotNumber :: SnapshotNumber
$sel:snapshotNumber:OnInitTx :: SnapshotNumber
snapshotNumber, UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:OnInitTx :: UTCTime
contestationDeadline}
  Contest ContestObservation{UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:ContestObservation :: ContestObservation -> UTCTime
contestationDeadline, HeadId
headId :: HeadId
$sel:headId:ContestObservation :: ContestObservation -> HeadId
headId, SnapshotNumber
snapshotNumber :: SnapshotNumber
$sel:snapshotNumber:ContestObservation :: ContestObservation -> SnapshotNumber
snapshotNumber} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnContestTx{UTCTime
$sel:contestationDeadline:OnInitTx :: UTCTime
contestationDeadline :: UTCTime
contestationDeadline, HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, SnapshotNumber
$sel:snapshotNumber:OnInitTx :: SnapshotNumber
snapshotNumber :: SnapshotNumber
snapshotNumber}
  Fanout FanoutObservation{HeadId
headId :: HeadId
$sel:headId:FanoutObservation :: FanoutObservation -> HeadId
headId, UTxO
fanoutUTxO :: UTxO
$sel:fanoutUTxO:FanoutObservation :: FanoutObservation -> UTxO
fanoutUTxO} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnFanoutTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, UTxOType Tx
UTxO
fanoutUTxO :: UTxO
$sel:fanoutUTxO:OnInitTx :: UTxOType Tx
fanoutUTxO}
  FinalPartialFanout FanoutObservation{HeadId
$sel:headId:FanoutObservation :: FanoutObservation -> HeadId
headId :: HeadId
headId, UTxO
$sel:fanoutUTxO:FanoutObservation :: FanoutObservation -> UTxO
fanoutUTxO :: UTxO
fanoutUTxO} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnFanoutTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, UTxOType Tx
UTxO
$sel:fanoutUTxO:OnInitTx :: UTxOType Tx
fanoutUTxO :: UTxO
fanoutUTxO}
  PartialFanout PartialFanoutObservation{HeadId
headId :: HeadId
$sel:headId:PartialFanoutObservation :: PartialFanoutObservation -> HeadId
headId, UTxO
distributedOutputs :: UTxO
$sel:distributedOutputs:PartialFanoutObservation :: PartialFanoutObservation -> UTxO
distributedOutputs} ->
    OnChainTx Tx -> Maybe (OnChainTx Tx)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnPartialFanoutTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, UTxOType Tx
UTxO
distributedOutputs :: UTxO
$sel:distributedOutputs:OnInitTx :: UTxOType Tx
distributedOutputs}

prepareTxToPost ::
  forall m.
  (MonadSTM m, MonadThrow (STM m)) =>
  TimeHandle ->
  ChainContext ->
  -- | Spendable UTxO
  UTxOType Tx ->
  PostChainTx Tx ->
  STM m Tx
prepareTxToPost :: forall (m :: * -> *).
(MonadSTM m, MonadThrow (STM m)) =>
TimeHandle
-> ChainContext -> UTxOType Tx -> PostChainTx Tx -> STM m Tx
prepareTxToPost TimeHandle
timeHandle ChainContext
ctx UTxOType Tx
spendableUTxO PostChainTx Tx
tx =
  case PostChainTx Tx
tx of
    -- InitTx is handled in mkChain.postTx before reaching this function.
    InitTx{} -> PostTxError Tx -> STM m Tx
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall tx. PostTxError tx
NoSeedInput @Tx)
    IncrementTx{HeadSeed
$sel:headSeed:InitTx :: forall tx. PostChainTx tx -> HeadSeed
headSeed :: HeadSeed
headSeed, HeadId
headId :: HeadId
$sel:headId:InitTx :: forall tx. PostChainTx tx -> HeadId
headId, HeadParameters
$sel:headParameters:InitTx :: forall tx. PostChainTx tx -> HeadParameters
headParameters :: HeadParameters
headParameters, ConfirmedSnapshot Tx
incrementingSnapshot :: ConfirmedSnapshot Tx
$sel:incrementingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
incrementingSnapshot} -> do
      (SlotNo
_, UTCTime
currentTime) <- Either Text PointInTime -> STM m PointInTime
forall a. Either Text a -> STM m a
throwLeft Either Text PointInTime
currentPointInTime
      let HeadParameters{ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:HeadParameters :: HeadParameters -> ContestationPeriod
contestationPeriod} = HeadParameters
headParameters
      (SlotNo
upperBound, UTCTime
_) <- UTCTime -> ContestationPeriod -> STM m PointInTime
calculateTxUpperBoundFromContestationPeriod UTCTime
currentTime ContestationPeriod
contestationPeriod
      case ChainContext
-> UTxO
-> (HeadSeed, HeadId)
-> HeadParameters
-> ConfirmedSnapshot Tx
-> SlotNo
-> Either IncrementTxError Tx
increment ChainContext
ctx UTxOType Tx
UTxO
spendableUTxO (HeadSeed
headSeed, HeadId
headId) HeadParameters
headParameters ConfirmedSnapshot Tx
incrementingSnapshot SlotNo
upperBound of
        Left IncrementTxError
err -> PostTxError Tx -> STM m Tx
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FailedToConstructIncrementTx{$sel:failureReason:NoSeedInput :: Text
failureReason = IncrementTxError -> Text
forall b a. (Show a, IsString b) => a -> b
show IncrementTxError
err} :: PostTxError Tx)
        Right Tx
incrementTx' -> Tx -> STM m Tx
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
incrementTx'
    RecoverTx{HeadId
$sel:headId:InitTx :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, TxIdType Tx
recoverTxId :: TxIdType Tx
$sel:recoverTxId:InitTx :: forall tx. PostChainTx tx -> TxIdType tx
recoverTxId, ChainSlot
deadline :: ChainSlot
$sel:deadline:InitTx :: forall tx. PostChainTx tx -> ChainSlot
deadline} -> do
      case ChainContext
-> HeadId -> TxId -> UTxO -> SlotNo -> Either RecoverTxError Tx
recover ChainContext
ctx HeadId
headId TxIdType Tx
TxId
recoverTxId UTxOType Tx
UTxO
spendableUTxO (ChainSlot -> SlotNo
fromChainSlot ChainSlot
deadline) of
        Left RecoverTxError
err -> PostTxError Tx -> STM m Tx
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FailedToConstructRecoverTx{$sel:failureReason:NoSeedInput :: Text
failureReason = RecoverTxError -> Text
forall b a. (Show a, IsString b) => a -> b
show RecoverTxError
err} :: PostTxError Tx)
        Right Tx
recoverTx' -> Tx -> STM m Tx
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
recoverTx'
    DecrementTx{HeadSeed
$sel:headSeed:InitTx :: forall tx. PostChainTx tx -> HeadSeed
headSeed :: HeadSeed
headSeed, HeadId
$sel:headId:InitTx :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, HeadParameters
$sel:headParameters:InitTx :: forall tx. PostChainTx tx -> HeadParameters
headParameters :: HeadParameters
headParameters, ConfirmedSnapshot Tx
decrementingSnapshot :: ConfirmedSnapshot Tx
$sel:decrementingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
decrementingSnapshot} ->
      case ChainContext
-> UTxO
-> (HeadSeed, HeadId)
-> HeadParameters
-> ConfirmedSnapshot Tx
-> Either DecrementTxError Tx
decrement ChainContext
ctx UTxOType Tx
UTxO
spendableUTxO (HeadSeed
headSeed, HeadId
headId) HeadParameters
headParameters ConfirmedSnapshot Tx
decrementingSnapshot of
        Left DecrementTxError
err -> PostTxError Tx -> STM m Tx
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FailedToConstructDecrementTx{$sel:failureReason:NoSeedInput :: Text
failureReason = DecrementTxError -> Text
forall b a. (Show a, IsString b) => a -> b
show DecrementTxError
err} :: PostTxError Tx)
        Right Tx
decrementTx' -> Tx -> STM m Tx
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
decrementTx'
    CloseTx{HeadId
$sel:headId:InitTx :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, HeadParameters
$sel:headParameters:InitTx :: forall tx. PostChainTx tx -> HeadParameters
headParameters :: HeadParameters
headParameters, SnapshotVersion
openVersion :: SnapshotVersion
$sel:openVersion:InitTx :: forall tx. PostChainTx tx -> SnapshotVersion
openVersion, ConfirmedSnapshot Tx
closingSnapshot :: ConfirmedSnapshot Tx
$sel:closingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
closingSnapshot} -> do
      (SlotNo
currentSlot, UTCTime
currentTime) <- Either Text PointInTime -> STM m PointInTime
forall a. Either Text a -> STM m a
throwLeft Either Text PointInTime
currentPointInTime
      let HeadParameters{ContestationPeriod
$sel:contestationPeriod:HeadParameters :: HeadParameters -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod} = HeadParameters
headParameters
      PointInTime
upperBound <- UTCTime -> ContestationPeriod -> STM m PointInTime
calculateTxUpperBoundFromContestationPeriod UTCTime
currentTime ContestationPeriod
contestationPeriod
      case ChainContext
-> UTxO
-> HeadId
-> HeadParameters
-> SnapshotVersion
-> ConfirmedSnapshot Tx
-> SlotNo
-> PointInTime
-> Either CloseTxError Tx
close ChainContext
ctx UTxOType Tx
UTxO
spendableUTxO HeadId
headId HeadParameters
headParameters SnapshotVersion
openVersion ConfirmedSnapshot Tx
closingSnapshot SlotNo
currentSlot PointInTime
upperBound of
        Left CloseTxError
_ -> PostTxError Tx -> STM m Tx
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (forall tx. PostTxError tx
FailedToConstructCloseTx @Tx)
        Right Tx
closeTx -> Tx -> STM m Tx
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
closeTx
    ContestTx{HeadId
$sel:headId:InitTx :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, HeadParameters
$sel:headParameters:InitTx :: forall tx. PostChainTx tx -> HeadParameters
headParameters :: HeadParameters
headParameters, SnapshotVersion
$sel:openVersion:InitTx :: forall tx. PostChainTx tx -> SnapshotVersion
openVersion :: SnapshotVersion
openVersion, ConfirmedSnapshot Tx
contestingSnapshot :: ConfirmedSnapshot Tx
$sel:contestingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
contestingSnapshot} -> do
      (SlotNo
_, UTCTime
currentTime) <- Either Text PointInTime -> STM m PointInTime
forall a. Either Text a -> STM m a
throwLeft Either Text PointInTime
currentPointInTime
      let HeadParameters{ContestationPeriod
$sel:contestationPeriod:HeadParameters :: HeadParameters -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod} = HeadParameters
headParameters
      PointInTime
upperBound <- UTCTime -> ContestationPeriod -> STM m PointInTime
calculateTxUpperBoundFromContestationPeriod UTCTime
currentTime ContestationPeriod
contestationPeriod
      case ChainContext
-> UTxO
-> HeadId
-> ContestationPeriod
-> SnapshotVersion
-> ConfirmedSnapshot Tx
-> PointInTime
-> Either ContestTxError Tx
contest ChainContext
ctx UTxOType Tx
UTxO
spendableUTxO HeadId
headId ContestationPeriod
contestationPeriod SnapshotVersion
openVersion ConfirmedSnapshot Tx
contestingSnapshot PointInTime
upperBound of
        Left ContestTxError
_ -> PostTxError Tx -> STM m Tx
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (forall tx. PostTxError tx
FailedToConstructContestTx @Tx)
        Right Tx
contestTx -> Tx -> STM m Tx
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
contestTx
    -- These are handled in mkChain.postTx before reaching this function.
    FanoutTx{} -> PostTxError Tx -> STM m Tx
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (PostTxError Tx
forall tx. PostTxError tx
FailedToConstructFanoutTx :: PostTxError Tx)
    FinalPartialFanoutTx{} -> PostTxError Tx -> STM m Tx
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (PostTxError Tx
forall tx. PostTxError tx
FailedToConstructPartialFanoutTx :: PostTxError Tx)
    PartialFanoutTx{} -> PostTxError Tx -> STM m Tx
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (PostTxError Tx
forall tx. PostTxError tx
FailedToConstructPartialFanoutTx :: PostTxError Tx)
 where
  -- XXX: Might want a dedicated exception type here
  throwLeft :: Either Text a -> STM m a
  throwLeft :: forall a. Either Text a -> STM m a
throwLeft = (Text -> STM m a) -> (a -> STM m a) -> Either Text a -> STM m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOError -> STM m a
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (IOError -> STM m a) -> (Text -> IOError) -> Text -> STM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IOError) -> (Text -> String) -> Text -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString) a -> STM m a
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  TimeHandle{Either Text PointInTime
$sel:currentPointInTime:TimeHandle :: TimeHandle -> Either Text PointInTime
currentPointInTime :: Either Text PointInTime
currentPointInTime, UTCTime -> Either Text SlotNo
$sel:slotFromUTCTime:TimeHandle :: TimeHandle -> UTCTime -> Either Text SlotNo
slotFromUTCTime :: UTCTime -> Either Text SlotNo
slotFromUTCTime} = TimeHandle
timeHandle

  -- See ADR21 for context
  calculateTxUpperBoundFromContestationPeriod :: UTCTime -> ContestationPeriod -> STM m PointInTime
calculateTxUpperBoundFromContestationPeriod UTCTime
currentTime ContestationPeriod
contestationPeriod = do
    let effectiveDelay :: NominalDiffTime
effectiveDelay = NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
min (ContestationPeriod -> NominalDiffTime
toNominalDiffTime ContestationPeriod
contestationPeriod) NominalDiffTime
maxGraceTime
    let upperBoundTime :: UTCTime
upperBoundTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
effectiveDelay UTCTime
currentTime
    SlotNo
upperBoundSlot <- Either Text SlotNo -> STM m SlotNo
forall a. Either Text a -> STM m a
throwLeft (Either Text SlotNo -> STM m SlotNo)
-> Either Text SlotNo -> STM m SlotNo
forall a b. (a -> b) -> a -> b
$ UTCTime -> Either Text SlotNo
slotFromUTCTime UTCTime
upperBoundTime
    PointInTime -> STM m PointInTime
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
upperBoundSlot, UTCTime
upperBoundTime)

-- | Binary search for the largest chunk size in @[1..maxChunk]@ for which
-- 'tryTx' returns 'Just'. Assumes the predicate is monotone: if size @n@ fits,
-- all sizes @< n@ also fit. Uses upper-mid so the search terminates correctly
-- when @hi = lo + 1@. Returns 'Left ()' if no size fits. 'tryTx' may throw to
-- abort the search early.
findLargestFitting ::
  Monad m =>
  -- | Construct and check a transaction; Just tx = fits, Nothing = doesn't fit; may throw on structural failure
  (Int -> m (Maybe tx)) ->
  -- | Upper bound of chunk sizes to search (inclusive)
  Int ->
  m (Either () tx)
findLargestFitting :: forall (m :: * -> *) tx.
Monad m =>
(Int -> m (Maybe tx)) -> Int -> m (Either () tx)
findLargestFitting Int -> m (Maybe tx)
tryTx = Either () tx -> Int -> Int -> m (Either () tx)
go (() -> Either () tx
forall a b. a -> Either a b
Left ()) Int
1
 where
  go :: Either () tx -> Int -> Int -> m (Either () tx)
go Either () tx
best Int
lo Int
hi
    | Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
hi = Either () tx -> m (Either () tx)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either () tx
best
    | Bool
otherwise = do
        let mid :: Int
mid = (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 -- ceiling division: biases toward hi so we test the larger candidate first
        Int -> m (Maybe tx)
tryTx Int
mid m (Maybe tx) -> (Maybe tx -> m (Either () tx)) -> m (Either () tx)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just tx
tx -> Either () tx -> Int -> Int -> m (Either () tx)
go (tx -> Either () tx
forall a b. b -> Either a b
Right tx
tx) (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
hi
          Maybe tx
Nothing -> Either () tx -> Int -> Int -> m (Either () tx)
go Either () tx
best Int
lo (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Check whether a transaction fits within protocol size and script execution
-- limits. Size check is cheap so it short-circuits before the expensive UPLC
-- evaluation. Structural errors (script failures, protocol parameter conversion
-- errors) are traced via the provided tracer; transient misses (size exceeded,
-- budget overrun) are silent.
fitsTx ::
  Monad m =>
  Tracer m CardanoChainLog ->
  (Tx -> m Bool) ->
  (Tx -> UTxO -> m (Either EvaluationError EvaluationReport)) ->
  UTxO ->
  Tx ->
  m Bool
fitsTx :: forall (m :: * -> *).
Monad m =>
Tracer m CardanoChainLog
-> (Tx -> m Bool)
-> (Tx -> UTxO -> m (Either EvaluationError EvaluationReport))
-> UTxO
-> Tx
-> m Bool
fitsTx Tracer m CardanoChainLog
tracer Tx -> m Bool
withinSizeLimits Tx -> UTxO -> m (Either EvaluationError EvaluationReport)
evalCosts UTxO
evalUTxO Tx
tx = do
  Bool
withinSize <- Tx -> m Bool
withinSizeLimits Tx
tx
  if Bool
withinSize
    then
      Tx -> UTxO -> m (Either EvaluationError EvaluationReport)
evalCosts Tx
tx UTxO
evalUTxO m (Either EvaluationError EvaluationReport)
-> (Either EvaluationError EvaluationReport -> m Bool) -> m Bool
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left TransactionBudgetOverspent{} -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Left (TransactionInvalid TransactionValidityError Era
err) -> Bool
False Bool -> m () -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tracer m CardanoChainLog -> CardanoChainLog -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m CardanoChainLog
tracer PartialFanoutFailed{$sel:reason:ToPost :: Text
reason = TransactionValidityError Era -> Text
forall b a. (Show a, IsString b) => a -> b
show TransactionValidityError Era
err}
        Left (PParamsConversion ProtocolParametersConversionError
err) -> Bool
False Bool -> m () -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tracer m CardanoChainLog -> CardanoChainLog -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m CardanoChainLog
tracer PartialFanoutFailed{$sel:reason:ToPost :: Text
reason = ProtocolParametersConversionError -> Text
forall b a. (Show a, IsString b) => a -> b
show ProtocolParametersConversionError
err}
        Right EvaluationReport
report ->
          let failures :: EvaluationReport
failures = (Either ScriptExecutionError ExecutionUnits -> Bool)
-> EvaluationReport -> EvaluationReport
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Either ScriptExecutionError ExecutionUnits -> Bool
forall a b. Either a b -> Bool
isLeft EvaluationReport
report
           in if EvaluationReport -> Bool
forall k a. Map k a -> Bool
Map.null EvaluationReport
failures
                then Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                else Bool
False Bool -> m () -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tracer m CardanoChainLog -> CardanoChainLog -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m CardanoChainLog
tracer PartialFanoutFailed{$sel:reason:ToPost :: Text
reason = EvaluationReport -> Text
renderEvaluationReport EvaluationReport
failures}
    else Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Try the preferred transaction first; if it doesn't fit within the script
-- execution budget or exceeds the maximum transaction size, fall back to a
-- binary search over partial fanout chunk sizes. Returns the largest chunk that
-- fits, minimising the number of fanout steps.
--
-- Error mapping:
--   * 'StaleChainState' from 'partialFanout' → 'StalePartialFanoutTx' (race
--     condition; HeadLogic silently ignores it and the chain observation loop
--     triggers the correct next step).
--   * Any other 'PartialFanoutError' → 'FailedToConstructPartialFanoutTx'
--     (structural mismatch that will not resolve on retry).
--   * No chunk fits within budget → 'FailedToConstructPartialFanoutTx'
--     (budget exhaustion; also not a race condition).
findFittingFanoutTx ::
  forall m.
  MonadThrow m =>
  Tracer m CardanoChainLog ->
  TinyWallet m ->
  ChainContext ->
  -- | Spendable UTxO containing head output
  UTxO ->
  -- | Seed TxIn
  TxIn ->
  -- | Preferred tx to try first (FanoutTx or FinalPartialFanoutTx); 'Nothing' skips straight to the fallback loop
  Maybe Tx ->
  -- | UTxO for the accumulator check in the partial-fanout fallback (matches the on-chain datum)
  UTxO ->
  -- | UTxOs to distribute in the partial-fanout fallback
  UTxO ->
  -- | Upper bound (inclusive) of chunk sizes to search in the fallback. For the
  --   final/full fanout fallback this is @size - 1@ (the preferred tx handles
  --   the full set; a partial fanout must leave at least one output). For an
  --   explicit non-final partial fanout this is the full @size@: the selection
  --   is always a strict subset of the head's remaining UTxO, so even
  --   distributing all of it leaves the unselected remainder in the accumulator
  --   and 'mustNotBeLastBatch' holds.
  Int ->
  -- | Contestation deadline as SlotNo
  SlotNo ->
  m Tx
findFittingFanoutTx :: forall (m :: * -> *).
MonadThrow m =>
Tracer m CardanoChainLog
-> TinyWallet m
-> ChainContext
-> UTxO
-> TxIn
-> Maybe Tx
-> UTxO
-> UTxO
-> Int
-> SlotNo
-> m Tx
findFittingFanoutTx Tracer m CardanoChainLog
tracer TinyWallet{Tx -> UTxO -> m (Either EvaluationError EvaluationReport)
evaluateScriptCosts :: Tx -> UTxO -> m (Either EvaluationError EvaluationReport)
$sel:evaluateScriptCosts:TinyWallet :: forall (m :: * -> *).
TinyWallet m
-> Tx -> UTxO -> m (Either EvaluationError EvaluationReport)
evaluateScriptCosts, Tx -> m Bool
isTxWithinSizeLimits :: Tx -> m Bool
$sel:isTxWithinSizeLimits:TinyWallet :: forall (m :: * -> *). TinyWallet m -> Tx -> m Bool
isTxWithinSizeLimits} ChainContext
ctx UTxO
spendableUTxO TxIn
seedTxIn Maybe Tx
ePreferred UTxO
proofUTxO UTxO
fullUTxO Int
maxChunkSize SlotNo
deadlineSlot =
  m (Either () Tx)
findBest m (Either () Tx) -> (Either () Tx -> m Tx) -> m Tx
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (() -> m Tx) -> (Tx -> m Tx) -> Either () Tx -> m Tx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m Tx -> () -> m Tx
forall a b. a -> b -> a
const (m Tx -> () -> m Tx) -> m Tx -> () -> m Tx
forall a b. (a -> b) -> a -> b
$ PostTxError Tx -> m Tx
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (forall tx. PostTxError tx
FailedToConstructPartialFanoutTx @Tx)) Tx -> m Tx
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
 where
  -- Try the preferred tx (full fanout or final partial fanout) first; only
  -- fall back to the binary search if it doesn't fit.
  findBest :: m (Either () Tx)
findBest = m (Either () Tx)
-> (Tx -> m (Either () Tx)) -> Maybe Tx -> m (Either () Tx)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Either () Tx)
findFallback Tx -> m (Either () Tx)
tryPreferred Maybe Tx
ePreferred
   where
    tryPreferred :: Tx -> m (Either () Tx)
tryPreferred Tx
tx = Tx -> m Bool
fits Tx
tx m Bool -> (Bool -> m (Either () Tx)) -> m (Either () Tx)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Either () Tx) -> m (Either () Tx) -> Bool -> m (Either () Tx)
forall a. a -> a -> Bool -> a
bool m (Either () Tx)
findFallback (Either () Tx -> m (Either () Tx)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> Either () Tx
forall a b. b -> Either a b
Right Tx
tx))

  findFallback :: m (Either () Tx)
findFallback = (Int -> m (Maybe Tx)) -> Int -> m (Either () Tx)
forall (m :: * -> *) tx.
Monad m =>
(Int -> m (Maybe tx)) -> Int -> m (Either () tx)
findLargestFitting Int -> m (Maybe Tx)
tryChunk Int
maxChunkSize
   where
    tryChunk :: Int -> m (Maybe Tx)
tryChunk Int
n = Int -> m Tx
buildTx Int
n m Tx -> (Tx -> m (Maybe Tx)) -> m (Maybe Tx)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Tx
tx -> Maybe Tx -> Maybe Tx -> Bool -> Maybe Tx
forall a. a -> a -> Bool -> a
bool Maybe Tx
forall a. Maybe a
Nothing (Tx -> Maybe Tx
forall a. a -> Maybe a
Just Tx
tx) (Bool -> Maybe Tx) -> m Bool -> m (Maybe Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx -> m Bool
fits Tx
tx

  buildTx :: Int -> m Tx
buildTx Int
n =
    (PartialFanoutError -> m Tx)
-> (Tx -> m Tx) -> Either PartialFanoutError Tx -> m Tx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PartialFanoutError -> m Tx
handleErr Tx -> m Tx
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PartialFanoutError Tx -> m Tx)
-> Either PartialFanoutError Tx -> m Tx
forall a b. (a -> b) -> a -> b
$ ChainContext
-> UTxO
-> TxIn
-> Int
-> UTxO
-> UTxO
-> SlotNo
-> Either PartialFanoutError Tx
partialFanout ChainContext
ctx UTxO
spendableUTxO TxIn
seedTxIn Int
n UTxO
proofUTxO UTxO
fullUTxO SlotNo
deadlineSlot
   where
    handleErr :: PartialFanoutError -> m Tx
handleErr PartialFanoutError
err = do
      Tracer m CardanoChainLog -> CardanoChainLog -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m CardanoChainLog
tracer PartialFanoutFailed{$sel:reason:ToPost :: Text
reason = PartialFanoutError -> Text
forall b a. (Show a, IsString b) => a -> b
show PartialFanoutError
err}
      PostTxError Tx -> m Tx
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (PostTxError Tx -> m Tx) -> PostTxError Tx -> m Tx
forall a b. (a -> b) -> a -> b
$ case PartialFanoutError
err of
        PartialFanoutError
StaleChainState -> forall tx. PostTxError tx
StalePartialFanoutTx @Tx
        PartialFanoutError
_ -> forall tx. PostTxError tx
FailedToConstructPartialFanoutTx @Tx

  fits :: Tx -> m Bool
fits = Tracer m CardanoChainLog
-> (Tx -> m Bool)
-> (Tx -> UTxO -> m (Either EvaluationError EvaluationReport))
-> UTxO
-> Tx
-> m Bool
forall (m :: * -> *).
Monad m =>
Tracer m CardanoChainLog
-> (Tx -> m Bool)
-> (Tx -> UTxO -> m (Either EvaluationError EvaluationReport))
-> UTxO
-> Tx
-> m Bool
fitsTx Tracer m CardanoChainLog
tracer Tx -> m Bool
isTxWithinSizeLimits Tx -> UTxO -> m (Either EvaluationError EvaluationReport)
evaluateScriptCosts UTxO
evalUTxO

  evalUTxO :: UTxO
evalUTxO = UTxO
spendableUTxO UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> ChainContext -> UTxO
forall a. HasKnownUTxO a => a -> UTxO
getKnownUTxO ChainContext
ctx

-- | Maximum delay we put on the upper bound of transactions to fit into a block.
-- NOTE: This is highly depending on the network. If the security parameter and
-- epoch length result in a short horizon, this is problematic.
maxGraceTime :: NominalDiffTime
maxGraceTime :: NominalDiffTime
maxGraceTime = NominalDiffTime
200

--
-- Tracing
--

data StartingDecision
  = FromProvided ChainPoint
  | FromTip ChainPoint
  | FromPersisted
      { StartingDecision -> ChainPoint
chainPoint :: ChainPoint
      , StartingDecision -> Bool
startChainFromSet :: Bool
      -- ^ Whether the user-provided --start-chain-from point was set
      -- but ignored, because it was older than persisted points.
      }
  deriving stock (StartingDecision -> StartingDecision -> Bool
(StartingDecision -> StartingDecision -> Bool)
-> (StartingDecision -> StartingDecision -> Bool)
-> Eq StartingDecision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StartingDecision -> StartingDecision -> Bool
== :: StartingDecision -> StartingDecision -> Bool
$c/= :: StartingDecision -> StartingDecision -> Bool
/= :: StartingDecision -> StartingDecision -> Bool
Eq, Int -> StartingDecision -> ShowS
[StartingDecision] -> ShowS
StartingDecision -> String
(Int -> StartingDecision -> ShowS)
-> (StartingDecision -> String)
-> ([StartingDecision] -> ShowS)
-> Show StartingDecision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StartingDecision -> ShowS
showsPrec :: Int -> StartingDecision -> ShowS
$cshow :: StartingDecision -> String
show :: StartingDecision -> String
$cshowList :: [StartingDecision] -> ShowS
showList :: [StartingDecision] -> ShowS
Show, (forall x. StartingDecision -> Rep StartingDecision x)
-> (forall x. Rep StartingDecision x -> StartingDecision)
-> Generic StartingDecision
forall x. Rep StartingDecision x -> StartingDecision
forall x. StartingDecision -> Rep StartingDecision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StartingDecision -> Rep StartingDecision x
from :: forall x. StartingDecision -> Rep StartingDecision x
$cto :: forall x. Rep StartingDecision x -> StartingDecision
to :: forall x. Rep StartingDecision x -> StartingDecision
Generic)
  deriving anyclass ([StartingDecision] -> Value
[StartingDecision] -> Encoding
StartingDecision -> Bool
StartingDecision -> Value
StartingDecision -> Encoding
(StartingDecision -> Value)
-> (StartingDecision -> Encoding)
-> ([StartingDecision] -> Value)
-> ([StartingDecision] -> Encoding)
-> (StartingDecision -> Bool)
-> ToJSON StartingDecision
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StartingDecision -> Value
toJSON :: StartingDecision -> Value
$ctoEncoding :: StartingDecision -> Encoding
toEncoding :: StartingDecision -> Encoding
$ctoJSONList :: [StartingDecision] -> Value
toJSONList :: [StartingDecision] -> Value
$ctoEncodingList :: [StartingDecision] -> Encoding
toEncodingList :: [StartingDecision] -> Encoding
$comitField :: StartingDecision -> Bool
omitField :: StartingDecision -> Bool
ToJSON)

data CardanoChainLog
  = ToPost {CardanoChainLog -> PostChainTx Tx
toPost :: PostChainTx Tx}
  | PostingTx {CardanoChainLog -> TxId
txId :: TxId}
  | PostedTx {txId :: TxId}
  | PostingFailed {CardanoChainLog -> Tx
tx :: Tx, CardanoChainLog -> PostTxError Tx
postTxError :: PostTxError Tx}
  | RolledForward {CardanoChainLog -> ChainPoint
point :: ChainPoint, CardanoChainLog -> [TxId]
receivedTxIds :: [TxId]}
  | RolledBackward {point :: ChainPoint}
  | Wallet TinyWalletLog
  | StartingChainDecision StartingDecision
  | BlockfrostTransientError {CardanoChainLog -> Text
reason :: Text, CardanoChainLog -> Int
retryDelay :: Int}
  | PartialFanoutFailed {reason :: Text}
  deriving stock (CardanoChainLog -> CardanoChainLog -> Bool
(CardanoChainLog -> CardanoChainLog -> Bool)
-> (CardanoChainLog -> CardanoChainLog -> Bool)
-> Eq CardanoChainLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CardanoChainLog -> CardanoChainLog -> Bool
== :: CardanoChainLog -> CardanoChainLog -> Bool
$c/= :: CardanoChainLog -> CardanoChainLog -> Bool
/= :: CardanoChainLog -> CardanoChainLog -> Bool
Eq, Int -> CardanoChainLog -> ShowS
[CardanoChainLog] -> ShowS
CardanoChainLog -> String
(Int -> CardanoChainLog -> ShowS)
-> (CardanoChainLog -> String)
-> ([CardanoChainLog] -> ShowS)
-> Show CardanoChainLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CardanoChainLog -> ShowS
showsPrec :: Int -> CardanoChainLog -> ShowS
$cshow :: CardanoChainLog -> String
show :: CardanoChainLog -> String
$cshowList :: [CardanoChainLog] -> ShowS
showList :: [CardanoChainLog] -> ShowS
Show, (forall x. CardanoChainLog -> Rep CardanoChainLog x)
-> (forall x. Rep CardanoChainLog x -> CardanoChainLog)
-> Generic CardanoChainLog
forall x. Rep CardanoChainLog x -> CardanoChainLog
forall x. CardanoChainLog -> Rep CardanoChainLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CardanoChainLog -> Rep CardanoChainLog x
from :: forall x. CardanoChainLog -> Rep CardanoChainLog x
$cto :: forall x. Rep CardanoChainLog x -> CardanoChainLog
to :: forall x. Rep CardanoChainLog x -> CardanoChainLog
Generic)
  deriving anyclass ([CardanoChainLog] -> Value
[CardanoChainLog] -> Encoding
CardanoChainLog -> Bool
CardanoChainLog -> Value
CardanoChainLog -> Encoding
(CardanoChainLog -> Value)
-> (CardanoChainLog -> Encoding)
-> ([CardanoChainLog] -> Value)
-> ([CardanoChainLog] -> Encoding)
-> (CardanoChainLog -> Bool)
-> ToJSON CardanoChainLog
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CardanoChainLog -> Value
toJSON :: CardanoChainLog -> Value
$ctoEncoding :: CardanoChainLog -> Encoding
toEncoding :: CardanoChainLog -> Encoding
$ctoJSONList :: [CardanoChainLog] -> Value
toJSONList :: [CardanoChainLog] -> Value
$ctoEncodingList :: [CardanoChainLog] -> Encoding
toEncodingList :: [CardanoChainLog] -> Encoding
$comitField :: CardanoChainLog -> Bool
omitField :: CardanoChainLog -> Bool
ToJSON)