{-# LANGUAGE DuplicateRecordFields #-}

-- | Companion tiny-wallet for the direct chain component. This module provide
-- some useful utilities to tracking the wallet's UTXO, and accessing it
module Hydra.Chain.Direct.Wallet where

import Hydra.Prelude

import Cardano.Api.UTxO (UTxO)
import Cardano.Crypto.Hash.Class
import Cardano.Ledger.Address qualified as Ledger
import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusContext)
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoEraScript (..),
  AsIx (..),
  ExUnits (ExUnits),
  plutusScriptLanguage,
  unAsIx,
 )
import Cardano.Ledger.Alonzo.TxWits (
  Redeemers (..),
  datsTxWitsL,
 )
import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded)
import Cardano.Ledger.Api (
  AlonzoEraTx,
  BabbageEraTxBody,
  Conway,
  Data,
  EraCrypto,
  PParams,
  TransactionScriptFailure,
  Tx,
  bodyTxL,
  calcMinFeeTx,
  coinTxOutL,
  collateralInputsTxBodyL,
  ensureMinCoinTxOut,
  evalTxExUnits,
  feeTxBodyL,
  inputsTxBodyL,
  outputsTxBodyL,
  ppMaxTxExUnitsL,
  rdmrsTxWitsL,
  referenceInputsTxBodyL,
  reqSignerHashesTxBodyL,
  scriptIntegrityHashTxBodyL,
  scriptTxWitsL,
  witsTxL,
  pattern SpendingPurpose,
 )
import Cardano.Ledger.Api.UTxO (EraUTxO, ScriptsNeeded)
import Cardano.Ledger.Babbage.Tx (body, getLanguageView, hashScriptIntegrity)
import Cardano.Ledger.Babbage.Tx qualified as Babbage
import Cardano.Ledger.Babbage.TxBody qualified as Babbage
import Cardano.Ledger.Babbage.UTxO (getReferenceScripts)
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (
  TxUpgradeError,
 )
import Cardano.Ledger.Core qualified as Core
import Cardano.Ledger.Core qualified as Ledger
import Cardano.Ledger.Crypto (HASH, StandardCrypto)
import Cardano.Ledger.Hashes (EraIndependentTxBody)
import Cardano.Ledger.SafeHash qualified as SafeHash
import Cardano.Ledger.Shelley.API (unUTxO)
import Cardano.Ledger.Shelley.API qualified as Ledger
import Cardano.Ledger.Val (invert)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart (..))
import Control.Concurrent.Class.MonadSTM (check, newTVarIO, readTVarIO, writeTVar)
import Control.Lens (view, (%~), (.~), (^.))
import Data.List qualified as List
import Data.Map.Strict ((!))
import Data.Map.Strict qualified as Map
import Data.Ratio ((%))
import Data.Sequence.Strict ((|>))
import Data.Set qualified as Set
import Hydra.Cardano.Api (
  BlockHeader,
  ChainPoint,
  LedgerEra,
  NetworkId,
  PaymentCredential (PaymentCredentialByKey),
  PaymentKey,
  ShelleyAddr,
  SigningKey,
  StakeAddressReference (NoStakeAddress),
  VerificationKey,
  fromLedgerTx,
  fromLedgerTxIn,
  fromLedgerUTxO,
  getChainPoint,
  makeShelleyAddress,
  shelleyAddressInEra,
  toLedgerAddr,
  toLedgerTx,
  toLedgerUTxO,
  verificationKeyHash,
 )
import Hydra.Cardano.Api qualified as Api
import Hydra.Chain.CardanoClient (QueryPoint (..))
import Hydra.Ledger.Cardano ()
import Hydra.Logging (Tracer, traceWith)

type Address = Ledger.Addr StandardCrypto
type TxIn = Ledger.TxIn StandardCrypto
type TxOut = Ledger.TxOut LedgerEra

-- | A 'TinyWallet' is a small abstraction of a wallet with basic UTXO
-- management. The wallet is assumed to have only one address, and only one UTXO
-- at that address. It can sign transactions and keeps track of its UTXO behind
-- the scene.
--
-- The wallet is connecting to the node initially and when asked to 'reset'.
-- Otherwise it can be fed blocks via 'update' as the chain rolls forward.
data TinyWallet m = TinyWallet
  { forall (m :: * -> *). TinyWallet m -> STM m (Map TxIn TxOut)
getUTxO :: STM m (Map TxIn TxOut)
  -- ^ Return all known UTxO addressed to this wallet.
  , forall (m :: * -> *). TinyWallet m -> STM m (Maybe TxIn)
getSeedInput :: STM m (Maybe Api.TxIn)
  -- ^ Returns the /seed input/
  -- This is the special input needed by `Direct` chain component to initialise
  -- a head
  , forall (m :: * -> *). TinyWallet m -> Tx -> Tx
sign :: Api.Tx -> Api.Tx
  , forall (m :: * -> *).
TinyWallet m -> UTxO -> Tx -> m (Either ErrCoverFee Tx)
coverFee ::
      UTxO ->
      Api.Tx ->
      m (Either ErrCoverFee Api.Tx)
  , forall (m :: * -> *). TinyWallet m -> m ()
reset :: m ()
  -- ^ Re-initializ wallet against the latest tip of the node and start to
  -- ignore 'update' calls until reaching that tip.
  , forall (m :: * -> *). TinyWallet m -> BlockHeader -> [Tx] -> m ()
update :: BlockHeader -> [Api.Tx] -> m ()
  -- ^ Update the wallet state given a block and list of txs. May be ignored if
  -- wallet is still initializing.
  }

data WalletInfoOnChain = WalletInfoOnChain
  { WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
  , WalletInfoOnChain -> SystemStart
systemStart :: SystemStart
  , WalletInfoOnChain -> ChainPoint
tip :: ChainPoint
  -- ^ Latest point on chain the wallet knows of.
  }

type ChainQuery m = QueryPoint -> Api.Address ShelleyAddr -> m WalletInfoOnChain

watchUTxOUntil :: (Map TxIn TxOut -> Bool) -> TinyWallet IO -> IO (Map TxIn TxOut)
watchUTxOUntil :: (Map TxIn TxOut -> Bool) -> TinyWallet IO -> IO (Map TxIn TxOut)
watchUTxOUntil Map TxIn TxOut -> Bool
predicate TinyWallet{STM IO (Map TxIn TxOut)
$sel:getUTxO:TinyWallet :: forall (m :: * -> *). TinyWallet m -> STM m (Map TxIn TxOut)
getUTxO :: STM IO (Map TxIn TxOut)
getUTxO} = STM IO (Map TxIn TxOut) -> IO (Map TxIn TxOut)
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Map TxIn TxOut) -> IO (Map TxIn TxOut))
-> STM IO (Map TxIn TxOut) -> IO (Map TxIn TxOut)
forall a b. (a -> b) -> a -> b
$ do
  Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
u <- STM (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
STM IO (Map TxIn TxOut)
getUTxO
  Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
u Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> STM ()
-> STM (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a b. a -> STM b -> STM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> STM IO ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check (Map TxIn TxOut -> Bool
predicate Map TxIn TxOut
Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
u)

-- | Create a new tiny wallet handle.
newTinyWallet ::
  -- | A tracer for logging
  Tracer IO TinyWalletLog ->
  -- | Network identifier to generate our address.
  NetworkId ->
  -- | Credentials of the wallet.
  (VerificationKey PaymentKey, SigningKey PaymentKey) ->
  -- | A function to query UTxO, pparams, system start and epoch info from the
  -- node. Initially and on demand later.
  ChainQuery IO ->
  IO (EpochInfo (Either Text)) ->
  -- | A means to query some pparams.
  IO (PParams Conway) ->
  IO (TinyWallet IO)
newTinyWallet :: Tracer IO TinyWalletLog
-> NetworkId
-> (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ChainQuery IO
-> IO (EpochInfo (Either Text))
-> IO (PParams (ConwayEra StandardCrypto))
-> IO (TinyWallet IO)
newTinyWallet Tracer IO TinyWalletLog
tracer NetworkId
networkId (VerificationKey PaymentKey
vk, SigningKey PaymentKey
sk) ChainQuery IO
queryWalletInfo IO (EpochInfo (Either Text))
queryEpochInfo IO (PParams (ConwayEra StandardCrypto))
querySomePParams = do
  TVar WalletInfoOnChain
walletInfoVar <- WalletInfoOnChain -> IO (TVar WalletInfoOnChain)
WalletInfoOnChain -> IO (TVar IO WalletInfoOnChain)
forall a. a -> IO (TVar IO a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO (WalletInfoOnChain -> IO (TVar WalletInfoOnChain))
-> IO WalletInfoOnChain -> IO (TVar WalletInfoOnChain)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO WalletInfoOnChain
initialize
  let getUTxO :: STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
getUTxO = TVar IO WalletInfoOnChain -> STM IO WalletInfoOnChain
forall a. TVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar STM IO WalletInfoOnChain
-> (WalletInfoOnChain
    -> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> WalletInfoOnChain -> Map TxIn TxOut
WalletInfoOnChain
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
walletUTxO
  TinyWallet IO -> IO (TinyWallet IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TinyWallet
      { STM IO (Map TxIn TxOut)
STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
$sel:getUTxO:TinyWallet :: STM IO (Map TxIn TxOut)
getUTxO :: STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
getUTxO
      , $sel:getSeedInput:TinyWallet :: STM IO (Maybe TxIn)
getSeedInput = ((TxIn, BabbageTxOut (ConwayEra StandardCrypto)) -> TxIn)
-> Maybe (TxIn, BabbageTxOut (ConwayEra StandardCrypto))
-> Maybe TxIn
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxIn -> TxIn
fromLedgerTxIn (TxIn -> TxIn)
-> ((TxIn, BabbageTxOut (ConwayEra StandardCrypto)) -> TxIn)
-> (TxIn, BabbageTxOut (ConwayEra StandardCrypto))
-> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BabbageTxOut (ConwayEra StandardCrypto)) -> TxIn
forall a b. (a, b) -> a
fst) (Maybe (TxIn, BabbageTxOut (ConwayEra StandardCrypto))
 -> Maybe TxIn)
-> (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
    -> Maybe (TxIn, BabbageTxOut (ConwayEra StandardCrypto)))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Maybe TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (TxOut (ConwayEra StandardCrypto))
-> Maybe (TxIn, TxOut (ConwayEra StandardCrypto))
Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Maybe (TxIn, BabbageTxOut (ConwayEra StandardCrypto))
forall era.
EraTxOut era =>
Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
findLargestUTxO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)) -> Maybe TxIn)
-> STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> STM IO (Maybe TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
getUTxO
      , $sel:sign:TinyWallet :: Tx -> Tx
sign = SigningKey PaymentKey -> Tx -> Tx
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
Api.signTx SigningKey PaymentKey
sk
      , $sel:coverFee:TinyWallet :: UTxO -> Tx -> IO (Either ErrCoverFee Tx)
coverFee = \UTxO
lookupUTxO Tx
partialTx -> do
          let ledgerLookupUTxO :: Map (TxIn (EraCrypto LedgerEra)) TxOut
ledgerLookupUTxO = UTxO LedgerEra -> Map (TxIn (EraCrypto LedgerEra)) TxOut
forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO (UTxO LedgerEra -> Map (TxIn (EraCrypto LedgerEra)) TxOut)
-> UTxO LedgerEra -> Map (TxIn (EraCrypto LedgerEra)) TxOut
forall a b. (a -> b) -> a -> b
$ UTxO -> UTxO LedgerEra
toLedgerUTxO UTxO
lookupUTxO
          WalletInfoOnChain{Map TxIn TxOut
$sel:walletUTxO:WalletInfoOnChain :: WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
walletUTxO, SystemStart
$sel:systemStart:WalletInfoOnChain :: WalletInfoOnChain -> SystemStart
systemStart :: SystemStart
systemStart} <- TVar IO WalletInfoOnChain -> IO WalletInfoOnChain
forall a. TVar IO a -> IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar
          EpochInfo (Either Text)
epochInfo <- IO (EpochInfo (Either Text))
queryEpochInfo
          -- We query pparams here again as it's possible that a hardfork
          -- occurred and the pparams changed.
          PParams (ConwayEra StandardCrypto)
pparams <- IO (PParams (ConwayEra StandardCrypto))
querySomePParams
          Either ErrCoverFee Tx -> IO (Either ErrCoverFee Tx)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ErrCoverFee Tx -> IO (Either ErrCoverFee Tx))
-> Either ErrCoverFee Tx -> IO (Either ErrCoverFee Tx)
forall a b. (a -> b) -> a -> b
$
            Tx LedgerEra -> Tx
AlonzoTx (ConwayEra StandardCrypto) -> Tx
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx
              (AlonzoTx (ConwayEra StandardCrypto) -> Tx)
-> Either ErrCoverFee (AlonzoTx (ConwayEra StandardCrypto))
-> Either ErrCoverFee Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PParams (ConwayEra StandardCrypto)
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut (ConwayEra StandardCrypto))
-> Map TxIn (TxOut (ConwayEra StandardCrypto))
-> Tx (ConwayEra StandardCrypto)
-> Either ErrCoverFee (Tx (ConwayEra StandardCrypto))
forall era.
(EraCrypto era ~ StandardCrypto, EraPlutusContext era,
 AlonzoEraTx era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraUTxO era, BabbageEraTxBody era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Map TxIn (TxOut era)
-> Tx era
-> Either ErrCoverFee (Tx era)
coverFee_ PParams (ConwayEra StandardCrypto)
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map (TxIn (EraCrypto LedgerEra)) TxOut
Map TxIn (TxOut (ConwayEra StandardCrypto))
ledgerLookupUTxO Map TxIn (TxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
walletUTxO (Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
partialTx)
      , reset :: IO ()
reset = IO WalletInfoOnChain
initialize IO WalletInfoOnChain -> (WalletInfoOnChain -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> IO ()
STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM () -> IO ())
-> (WalletInfoOnChain -> STM ()) -> WalletInfoOnChain -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar IO WalletInfoOnChain -> WalletInfoOnChain -> STM IO ()
forall a. TVar IO a -> a -> STM IO ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar
      , update :: BlockHeader -> [Tx] -> IO ()
update = \BlockHeader
header [Tx]
txs -> do
          let point :: ChainPoint
point = BlockHeader -> ChainPoint
getChainPoint BlockHeader
header
          ChainPoint
walletTip <- STM IO ChainPoint -> IO ChainPoint
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO ChainPoint -> IO ChainPoint)
-> STM IO ChainPoint -> IO ChainPoint
forall a b. (a -> b) -> a -> b
$ TVar IO WalletInfoOnChain -> STM IO WalletInfoOnChain
forall a. TVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar STM WalletInfoOnChain
-> (WalletInfoOnChain -> ChainPoint) -> STM ChainPoint
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WalletInfoOnChain{ChainPoint
$sel:tip:WalletInfoOnChain :: WalletInfoOnChain -> ChainPoint
tip :: ChainPoint
tip} -> ChainPoint
tip
          if ChainPoint
point ChainPoint -> ChainPoint -> Bool
forall a. Ord a => a -> a -> Bool
< ChainPoint
walletTip
            then Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer (TinyWalletLog -> IO ()) -> TinyWalletLog -> IO ()
forall a b. (a -> b) -> a -> b
$ SkipUpdate{ChainPoint
point :: ChainPoint
$sel:point:BeginInitialize :: ChainPoint
point}
            else do
              Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer (TinyWalletLog -> IO ()) -> TinyWalletLog -> IO ()
forall a b. (a -> b) -> a -> b
$ BeginUpdate{ChainPoint
point :: ChainPoint
$sel:point:BeginInitialize :: ChainPoint
point}
              Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo' <- STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
 -> IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))))
-> STM IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> IO (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$ do
                walletInfo :: WalletInfoOnChain
walletInfo@WalletInfoOnChain{Map TxIn TxOut
$sel:walletUTxO:WalletInfoOnChain :: WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
walletUTxO} <- TVar IO WalletInfoOnChain -> STM IO WalletInfoOnChain
forall a. TVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar
                let utxo' :: Map TxIn TxOut
utxo' = [Tx]
-> (Addr StandardCrypto -> Bool)
-> Map TxIn TxOut
-> Map TxIn TxOut
applyTxs [Tx]
txs (Addr StandardCrypto -> Addr StandardCrypto -> Bool
forall a. Eq a => a -> a -> Bool
== Addr StandardCrypto
ledgerAddress) Map TxIn TxOut
walletUTxO
                TVar IO WalletInfoOnChain -> WalletInfoOnChain -> STM IO ()
forall a. TVar IO a -> a -> STM IO ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar WalletInfoOnChain
TVar IO WalletInfoOnChain
walletInfoVar (WalletInfoOnChain -> STM IO ()) -> WalletInfoOnChain -> STM IO ()
forall a b. (a -> b) -> a -> b
$ WalletInfoOnChain
walletInfo{walletUTxO = utxo', tip = point}
                Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> STM (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map TxIn TxOut
Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo'
              Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer (TinyWalletLog -> IO ()) -> TinyWalletLog -> IO ()
forall a b. (a -> b) -> a -> b
$ UTxO -> TinyWalletLog
EndUpdate (UTxO LedgerEra -> UTxO
fromLedgerUTxO (Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
-> UTxO (ConwayEra StandardCrypto)
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo'))
      }
 where
  initialize :: IO WalletInfoOnChain
initialize = do
    Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer TinyWalletLog
BeginInitialize
    walletInfo :: WalletInfoOnChain
walletInfo@WalletInfoOnChain{Map TxIn TxOut
$sel:walletUTxO:WalletInfoOnChain :: WalletInfoOnChain -> Map TxIn TxOut
walletUTxO :: Map TxIn TxOut
walletUTxO, ChainPoint
$sel:tip:WalletInfoOnChain :: WalletInfoOnChain -> ChainPoint
tip :: ChainPoint
tip} <- ChainQuery IO
queryWalletInfo QueryPoint
QueryTip Address ShelleyAddr
address
    Tracer IO TinyWalletLog -> TinyWalletLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TinyWalletLog
tracer (TinyWalletLog -> IO ()) -> TinyWalletLog -> IO ()
forall a b. (a -> b) -> a -> b
$ EndInitialize{$sel:initialUTxO:BeginInitialize :: UTxO
initialUTxO = UTxO LedgerEra -> UTxO
fromLedgerUTxO (Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
-> UTxO (ConwayEra StandardCrypto)
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
Map TxIn TxOut
walletUTxO), ChainPoint
tip :: ChainPoint
$sel:tip:BeginInitialize :: ChainPoint
tip}
    WalletInfoOnChain -> IO WalletInfoOnChain
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WalletInfoOnChain
walletInfo

  address :: Address ShelleyAddr
address =
    NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress NetworkId
networkId (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (Hash PaymentKey -> PaymentCredential)
-> Hash PaymentKey -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vk) StakeAddressReference
NoStakeAddress

  ledgerAddress :: Addr StandardCrypto
ledgerAddress = AddressInEra Era -> Addr StandardCrypto
forall era. AddressInEra era -> Addr StandardCrypto
toLedgerAddr (AddressInEra Era -> Addr StandardCrypto)
-> AddressInEra Era -> Addr StandardCrypto
forall a b. (a -> b) -> a -> b
$ forall era.
ShelleyBasedEra era -> Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra @Api.Era ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
Api.shelleyBasedEra Address ShelleyAddr
address

-- | Apply a block to our wallet. Does nothing if the transaction does not
-- modify the UTXO set, or else, remove consumed utxos and add produced ones.
--
-- To determine whether a produced output is ours, we apply the given function
-- checking the output's address.
applyTxs :: [Api.Tx] -> (Address -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
applyTxs :: [Tx]
-> (Addr StandardCrypto -> Bool)
-> Map TxIn TxOut
-> Map TxIn TxOut
applyTxs [Tx]
txs Addr StandardCrypto -> Bool
isOurs Map TxIn TxOut
utxo =
  (State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
 -> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
 -> Map TxIn TxOut)
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
-> Map TxIn TxOut
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Map TxIn TxOut
State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall s a. State s a -> s -> s
execState Map TxIn TxOut
Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
utxo (State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
 -> Map TxIn TxOut)
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
-> Map TxIn TxOut
forall a b. (a -> b) -> a -> b
$ do
    [Tx]
-> (Tx
    -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Tx]
txs ((Tx
  -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
 -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
-> (Tx
    -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
forall a b. (a -> b) -> a -> b
$ \Tx
apiTx -> do
      -- XXX: Use cardano-api types instead here
      let tx :: Tx LedgerEra
tx = Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
apiTx
      let txId :: TxId StandardCrypto
txId = AlonzoTx (ConwayEra StandardCrypto) -> TxId StandardCrypto
forall crypto (era :: * -> *).
(HashAlgorithm (HASH crypto),
 HashAnnotated (TxBody (era crypto)) EraIndependentTxBody crypto) =>
AlonzoTx (era crypto) -> TxId crypto
getTxId Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
tx
      (Map
   (TxIn (EraCrypto (ConwayEra StandardCrypto)))
   (BabbageTxOut (ConwayEra StandardCrypto))
 -> Map
      (TxIn (EraCrypto (ConwayEra StandardCrypto)))
      (BabbageTxOut (ConwayEra StandardCrypto)))
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (BabbageTxOut (ConwayEra StandardCrypto))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
-> Map
     (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Getting
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL (AlonzoTx (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
tx))
      let indexedOutputs :: [(TxIx, BabbageTxOut (ConwayEra StandardCrypto))]
indexedOutputs =
            let outs :: [BabbageTxOut (ConwayEra StandardCrypto)]
outs = StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
-> [BabbageTxOut (ConwayEra StandardCrypto)]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
 -> [BabbageTxOut (ConwayEra StandardCrypto)])
-> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
-> [BabbageTxOut (ConwayEra StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ AlonzoTx (ConwayEra StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
forall era. AlonzoTx era -> TxBody era
body Tx LedgerEra
AlonzoTx (ConwayEra StandardCrypto)
tx TxBody (ConwayEra StandardCrypto)
-> Getting
     (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
     (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
-> StrictSeq (BabbageTxOut (ConwayEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Const
      (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
      (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
Getting
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (BabbageTxOut (ConwayEra StandardCrypto)))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL
                maxIx :: Word64
maxIx = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [BabbageTxOut (ConwayEra StandardCrypto)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BabbageTxOut (ConwayEra StandardCrypto)]
outs
             in [TxIx]
-> [BabbageTxOut (ConwayEra StandardCrypto)]
-> [(TxIx, BabbageTxOut (ConwayEra StandardCrypto))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64 -> TxIx
Ledger.TxIx Word64
ix | Word64
ix <- [Word64
0 .. Word64
maxIx]] [BabbageTxOut (ConwayEra StandardCrypto)]
outs
      [(TxIx, BabbageTxOut (ConwayEra StandardCrypto))]
-> ((TxIx, BabbageTxOut (ConwayEra StandardCrypto))
    -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TxIx, BabbageTxOut (ConwayEra StandardCrypto))]
indexedOutputs (((TxIx, BabbageTxOut (ConwayEra StandardCrypto))
  -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
 -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
-> ((TxIx, BabbageTxOut (ConwayEra StandardCrypto))
    -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
forall a b. (a -> b) -> a -> b
$ \(TxIx
ix, out :: BabbageTxOut (ConwayEra StandardCrypto)
out@(Babbage.BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
addr Value (ConwayEra StandardCrypto)
_ Datum (ConwayEra StandardCrypto)
_ StrictMaybe (Script (ConwayEra StandardCrypto))
_)) ->
        Bool
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Addr StandardCrypto -> Bool
isOurs Addr (EraCrypto (ConwayEra StandardCrypto))
Addr StandardCrypto
addr) (State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
 -> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ())
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
forall a b. (a -> b) -> a -> b
$ (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
 -> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto)))
-> State (Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (TxIn
-> BabbageTxOut (ConwayEra StandardCrypto)
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
-> Map TxIn (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (TxId StandardCrypto -> TxIx -> TxIn
forall c. TxId c -> TxIx -> TxIn c
Ledger.TxIn TxId StandardCrypto
txId TxIx
ix) BabbageTxOut (ConwayEra StandardCrypto)
out)

getTxId ::
  ( HashAlgorithm (HASH crypto)
  , SafeHash.HashAnnotated
      (Ledger.TxBody (era crypto))
      EraIndependentTxBody
      crypto
  ) =>
  Babbage.AlonzoTx (era crypto) ->
  Ledger.TxId crypto
getTxId :: forall crypto (era :: * -> *).
(HashAlgorithm (HASH crypto),
 HashAnnotated (TxBody (era crypto)) EraIndependentTxBody crypto) =>
AlonzoTx (era crypto) -> TxId crypto
getTxId AlonzoTx (era crypto)
tx = SafeHash crypto EraIndependentTxBody -> TxId crypto
forall c. SafeHash c EraIndependentTxBody -> TxId c
Ledger.TxId (SafeHash crypto EraIndependentTxBody -> TxId crypto)
-> SafeHash crypto EraIndependentTxBody -> TxId crypto
forall a b. (a -> b) -> a -> b
$ TxBody (era crypto) -> SafeHash crypto EraIndependentTxBody
forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
SafeHash.hashAnnotated (AlonzoTx (era crypto) -> TxBody (era crypto)
forall era. AlonzoTx era -> TxBody era
body AlonzoTx (era crypto)
tx)

-- | This are all the error that can happen during coverFee.
data ErrCoverFee
  = ErrNotEnoughFunds ChangeError
  | ErrNoFuelUTxOFound
  | ErrUnknownInput {ErrCoverFee -> TxIn
input :: TxIn}
  | ErrScriptExecutionFailed {ErrCoverFee -> Text
redeemerPointer :: Text, ErrCoverFee -> Text
scriptFailure :: Text}
  | ErrTranslationError (ContextError LedgerEra)
  | ErrConwayUpgradeError (TxUpgradeError Conway)
  deriving stock (Int -> ErrCoverFee -> ShowS
[ErrCoverFee] -> ShowS
ErrCoverFee -> String
(Int -> ErrCoverFee -> ShowS)
-> (ErrCoverFee -> String)
-> ([ErrCoverFee] -> ShowS)
-> Show ErrCoverFee
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrCoverFee -> ShowS
showsPrec :: Int -> ErrCoverFee -> ShowS
$cshow :: ErrCoverFee -> String
show :: ErrCoverFee -> String
$cshowList :: [ErrCoverFee] -> ShowS
showList :: [ErrCoverFee] -> ShowS
Show)

data ChangeError = ChangeError {ChangeError -> Coin
inputBalance :: Coin, ChangeError -> Coin
outputBalance :: Coin}
  deriving stock (Int -> ChangeError -> ShowS
[ChangeError] -> ShowS
ChangeError -> String
(Int -> ChangeError -> ShowS)
-> (ChangeError -> String)
-> ([ChangeError] -> ShowS)
-> Show ChangeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeError -> ShowS
showsPrec :: Int -> ChangeError -> ShowS
$cshow :: ChangeError -> String
show :: ChangeError -> String
$cshowList :: [ChangeError] -> ShowS
showList :: [ChangeError] -> ShowS
Show)

-- | Cover fee for a transaction body using the given UTXO set. This calculate
-- necessary fees and augments inputs / outputs / collateral accordingly to
-- cover for the transaction cost and get the change back.
--
-- XXX: All call sites of this function use cardano-api types
coverFee_ ::
  ( EraCrypto era ~ StandardCrypto
  , EraPlutusContext era
  , AlonzoEraTx era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , EraUTxO era
  , BabbageEraTxBody era
  ) =>
  PParams era ->
  SystemStart ->
  EpochInfo (Either Text) ->
  Map TxIn (Ledger.TxOut era) ->
  Map TxIn (Ledger.TxOut era) ->
  Tx era ->
  Either ErrCoverFee (Tx era)
coverFee_ :: forall era.
(EraCrypto era ~ StandardCrypto, EraPlutusContext era,
 AlonzoEraTx era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraUTxO era, BabbageEraTxBody era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Map TxIn (TxOut era)
-> Tx era
-> Either ErrCoverFee (Tx era)
coverFee_ PParams era
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn (TxOut era)
lookupUTxO Map TxIn (TxOut era)
walletUTxO Tx era
partialTx = do
  let body :: TxBody era
body = Tx era
partialTx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL
  let wits :: TxWits era
wits = Tx era
partialTx Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL
  (TxIn
feeTxIn, TxOut era
feeTxOut) <- Map TxIn (TxOut era) -> Either ErrCoverFee (TxIn, TxOut era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraTxOut era) =>
Map TxIn (TxOut era) -> Either ErrCoverFee (TxIn, TxOut era)
findUTxOToPayFees Map TxIn (TxOut era)
walletUTxO

  let newInputs :: Set TxIn
newInputs = TxBody era
body TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (Set (TxIn (EraCrypto era))
 -> Const (Set TxIn) (Set (TxIn (EraCrypto era))))
-> TxBody era -> Const (Set TxIn) (TxBody era)
Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL Set TxIn -> Set TxIn -> Set TxIn
forall a. Semigroup a => a -> a -> a
<> TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
feeTxIn
  [TxOut era]
resolvedInputs <- (TxIn -> Either ErrCoverFee (TxOut era))
-> [TxIn] -> Either ErrCoverFee [TxOut era]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse TxIn -> Either ErrCoverFee (TxOut era)
resolveInput (Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TxIn
newInputs)

  -- Ensure we have at least the minimum amount of ada. NOTE: setMinCoinTxOut
  -- would invalidate most Hydra protocol transactions.
  let txOuts :: StrictSeq (TxOut era)
txOuts = TxBody era
body TxBody era
-> Getting
     (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL StrictSeq (TxOut era)
-> (TxOut era -> TxOut era) -> StrictSeq (TxOut era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PParams era -> TxOut era -> TxOut era
forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut PParams era
pparams

  -- Compute costs of redeemers
  let utxo :: Map TxIn (TxOut era)
utxo = Map TxIn (TxOut era)
lookupUTxO Map TxIn (TxOut era)
-> Map TxIn (TxOut era) -> Map TxIn (TxOut era)
forall a. Semigroup a => a -> a -> a
<> Map TxIn (TxOut era)
walletUTxO
  Map (PlutusPurpose AsIx era) ExUnits
estimatedScriptCosts <- PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Tx era
-> Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
forall era.
(AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraCrypto era ~ StandardCrypto, EraUTxO era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Tx era
-> Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
estimateScriptsCost PParams era
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn (TxOut era)
utxo Tx era
partialTx
  let adjustedRedeemers :: Redeemers era
adjustedRedeemers =
        Set TxIn
-> Set TxIn
-> Map (PlutusPurpose AsIx era) ExUnits
-> Redeemers era
-> Redeemers era
forall era.
AlonzoEraScript era =>
Set TxIn
-> Set TxIn
-> Map (PlutusPurpose AsIx era) ExUnits
-> Redeemers era
-> Redeemers era
adjustRedeemers
          (TxBody era
body TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (Set (TxIn (EraCrypto era))
 -> Const (Set TxIn) (Set (TxIn (EraCrypto era))))
-> TxBody era -> Const (Set TxIn) (TxBody era)
Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL)
          Set TxIn
newInputs
          Map (PlutusPurpose AsIx era) ExUnits
estimatedScriptCosts
          (TxWits era
wits TxWits era
-> Getting (Redeemers era) (TxWits era) (Redeemers era)
-> Redeemers era
forall s a. s -> Getting a s a -> a
^. Getting (Redeemers era) (TxWits era) (Redeemers era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL)

  -- Compute script integrity hash from adjusted redeemers
  let referenceScripts :: Map (ScriptHash (EraCrypto era)) (Script era)
referenceScripts = UTxO era
-> Set (TxIn (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
forall era.
BabbageEraTxOut era =>
UTxO era
-> Set (TxIn (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
getReferenceScripts (Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map (TxIn (EraCrypto era)) (TxOut era)
Map TxIn (TxOut era)
utxo) (TxBody era
body TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (Set (TxIn (EraCrypto era))
 -> Const (Set TxIn) (Set (TxIn (EraCrypto era))))
-> TxBody era -> Const (Set TxIn) (TxBody era)
Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL)
      langs :: [LangDepView]
langs =
        [ PParams era -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams era
pparams Language
l
        | Script era
script <- Map (ScriptHash (EraCrypto era)) (Script era) -> [Script era]
forall a. Map (ScriptHash (EraCrypto era)) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Map (ScriptHash (EraCrypto era)) (Script era) -> [Script era])
-> Map (ScriptHash (EraCrypto era)) (Script era) -> [Script era]
forall a b. (a -> b) -> a -> b
$ (TxWits era
wits TxWits era
-> Getting
     (Map (ScriptHash (EraCrypto era)) (Script era))
     (TxWits era)
     (Map (ScriptHash (EraCrypto era)) (Script era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (ScriptHash (EraCrypto era)) (Script era))
  (TxWits era)
  (Map (ScriptHash (EraCrypto era)) (Script era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
scriptTxWitsL) Map (ScriptHash (EraCrypto era)) (Script era)
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Map (ScriptHash (EraCrypto era)) (Script era)
forall a. Semigroup a => a -> a -> a
<> Map (ScriptHash (EraCrypto era)) (Script era)
referenceScripts
        , Language
l <- Maybe Language -> [Language]
forall a. Maybe a -> [a]
maybeToList (Maybe Language -> [Language]) -> Maybe Language -> [Language]
forall a b. (a -> b) -> a -> b
$ PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage (PlutusScript era -> Language)
-> Maybe (PlutusScript era) -> Maybe Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script era -> Maybe (PlutusScript era)
forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript Script era
script
        ]
      scriptIntegrityHash :: StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash =
        Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity
          ([LangDepView] -> Set LangDepView
forall a. Ord a => [a] -> Set a
Set.fromList [LangDepView]
langs)
          Redeemers era
adjustedRedeemers
          (TxWits era
wits TxWits era
-> Getting (TxDats era) (TxWits era) (TxDats era) -> TxDats era
forall s a. s -> Getting a s a -> a
^. Getting (TxDats era) (TxWits era) (TxDats era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL)
  let
    unbalancedBody :: TxBody era
unbalancedBody =
      TxBody era
body
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto era))
 -> Identity (Set (TxIn (EraCrypto era))))
-> TxBody era -> Identity (TxBody era)
(Set (TxIn (EraCrypto era)) -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL ((Set (TxIn (EraCrypto era)) -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
newInputs
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
txOuts
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto era))
 -> Identity (Set (TxIn (EraCrypto era))))
-> TxBody era -> Identity (TxBody era)
(Set (TxIn (EraCrypto era)) -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL ((Set (TxIn (EraCrypto era)) -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
feeTxIn
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (ScriptIntegrityHash (EraCrypto era))
 -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto era))))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
scriptIntegrityHashTxBodyL ((StrictMaybe (ScriptIntegrityHash (EraCrypto era))
  -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto era))))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBody era
-> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash
    unbalancedTx :: Tx era
unbalancedTx =
      Tx era
partialTx
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> TxBody era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxBody era
unbalancedBody
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
adjustedRedeemers

  -- Compute fee using a body with selected txOut to pay fees (= full change)
  -- and an aditional witness (we will sign this tx later)
  let fee :: Coin
fee = UTxO era -> PParams era -> Tx era -> Int -> Coin
forall era.
EraUTxO era =>
UTxO era -> PParams era -> Tx era -> Int -> Coin
calcMinFeeTx (Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map (TxIn (EraCrypto era)) (TxOut era)
Map TxIn (TxOut era)
utxo) PParams era
pparams Tx era
costingTx Int
additionalWitnesses
      costingTx :: Tx era
costingTx =
        Tx era
unbalancedTx
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> Tx era -> Identity (Tx era))
-> (StrictSeq (TxOut era) -> StrictSeq (TxOut era))
-> Tx era
-> Tx era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StrictSeq (TxOut era) -> TxOut era -> StrictSeq (TxOut era)
forall a. StrictSeq a -> a -> StrictSeq a
|> TxOut era
feeTxOut)
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> (Coin -> Identity Coin)
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> Tx era -> Identity (Tx era))
-> Coin -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
10_000_000
      -- We add one additional witness for the fee input
      additionalWitnesses :: Int
additionalWitnesses = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set (KeyHash 'Witness (EraCrypto era)) -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx era
partialTx Tx era
-> Getting
     (Set (KeyHash 'Witness (EraCrypto era)))
     (Tx era)
     (Set (KeyHash 'Witness (EraCrypto era)))
-> Set (KeyHash 'Witness (EraCrypto era))
forall s a. s -> Getting a s a -> a
^. (TxBody era
 -> Const (Set (KeyHash 'Witness (EraCrypto era))) (TxBody era))
-> Tx era
-> Const (Set (KeyHash 'Witness (EraCrypto era))) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era
  -> Const (Set (KeyHash 'Witness (EraCrypto era))) (TxBody era))
 -> Tx era
 -> Const (Set (KeyHash 'Witness (EraCrypto era))) (Tx era))
-> ((Set (KeyHash 'Witness (EraCrypto era))
     -> Const
          (Set (KeyHash 'Witness (EraCrypto era)))
          (Set (KeyHash 'Witness (EraCrypto era))))
    -> TxBody era
    -> Const (Set (KeyHash 'Witness (EraCrypto era))) (TxBody era))
-> Getting
     (Set (KeyHash 'Witness (EraCrypto era)))
     (Tx era)
     (Set (KeyHash 'Witness (EraCrypto era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (KeyHash 'Witness (EraCrypto era))
 -> Const
      (Set (KeyHash 'Witness (EraCrypto era)))
      (Set (KeyHash 'Witness (EraCrypto era))))
-> TxBody era
-> Const (Set (KeyHash 'Witness (EraCrypto era))) (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashesTxBodyL)

  -- Balance tx with a change output and computed fee
  TxOut era
change <-
    (ChangeError -> ErrCoverFee)
-> Either ChangeError (TxOut era) -> Either ErrCoverFee (TxOut era)
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 ChangeError -> ErrCoverFee
ErrNotEnoughFunds (Either ChangeError (TxOut era) -> Either ErrCoverFee (TxOut era))
-> Either ChangeError (TxOut era) -> Either ErrCoverFee (TxOut era)
forall a b. (a -> b) -> a -> b
$
      TxOut era
-> [TxOut era]
-> [TxOut era]
-> Coin
-> Either ChangeError (TxOut era)
forall {era} {era} {era} {t :: * -> *} {t :: * -> *}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Foldable t, Foldable t, EraTxOut era, EraTxOut era,
 EraTxOut era) =>
TxOut era
-> t (TxOut era)
-> t (TxOut era)
-> Coin
-> Either ChangeError (TxOut era)
mkChange
        TxOut era
feeTxOut
        [TxOut era]
resolvedInputs
        (StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
txOuts)
        Coin
fee
  Tx era -> Either ErrCoverFee (Tx era)
forall a. a -> Either ErrCoverFee a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx era -> Either ErrCoverFee (Tx era))
-> Tx era -> Either ErrCoverFee (Tx era)
forall a b. (a -> b) -> a -> b
$
    Tx era
unbalancedTx
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> Tx era -> Identity (Tx era))
-> (StrictSeq (TxOut era) -> StrictSeq (TxOut era))
-> Tx era
-> Tx era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StrictSeq (TxOut era) -> TxOut era -> StrictSeq (TxOut era)
forall a. StrictSeq a -> a -> StrictSeq a
|> TxOut era
change)
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> (Coin -> Identity Coin)
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> Tx era -> Identity (Tx era))
-> Coin -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee
 where
  findUTxOToPayFees :: Map TxIn (TxOut era) -> Either ErrCoverFee (TxIn, TxOut era)
findUTxOToPayFees Map TxIn (TxOut era)
utxo = case Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
forall era.
EraTxOut era =>
Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
findLargestUTxO Map TxIn (TxOut era)
utxo of
    Maybe (TxIn, TxOut era)
Nothing ->
      ErrCoverFee -> Either ErrCoverFee (TxIn, TxOut era)
forall a b. a -> Either a b
Left ErrCoverFee
ErrNoFuelUTxOFound
    Just (TxIn
i, TxOut era
o) ->
      (TxIn, TxOut era) -> Either ErrCoverFee (TxIn, TxOut era)
forall a b. b -> Either a b
Right (TxIn
i, TxOut era
o)

  resolveInput :: TxIn -> Either ErrCoverFee (TxOut era)
resolveInput TxIn
i = do
    case TxIn -> Map TxIn (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
i (Map TxIn (TxOut era)
lookupUTxO Map TxIn (TxOut era)
-> Map TxIn (TxOut era) -> Map TxIn (TxOut era)
forall a. Semigroup a => a -> a -> a
<> Map TxIn (TxOut era)
walletUTxO) of
      Maybe (TxOut era)
Nothing -> ErrCoverFee -> Either ErrCoverFee (TxOut era)
forall a b. a -> Either a b
Left (ErrCoverFee -> Either ErrCoverFee (TxOut era))
-> ErrCoverFee -> Either ErrCoverFee (TxOut era)
forall a b. (a -> b) -> a -> b
$ TxIn -> ErrCoverFee
ErrUnknownInput TxIn
i
      Just TxOut era
o -> TxOut era -> Either ErrCoverFee (TxOut era)
forall a b. b -> Either a b
Right TxOut era
o

  mkChange :: TxOut era
-> t (TxOut era)
-> t (TxOut era)
-> Coin
-> Either ChangeError (TxOut era)
mkChange TxOut era
feeTxOut t (TxOut era)
resolvedInputs t (TxOut era)
otherOutputs Coin
fee
    -- FIXME: The delta between in and out must be greater than the min utxo value!
    | Coin
totalIn Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
totalOut =
        ChangeError -> Either ChangeError (TxOut era)
forall a b. a -> Either a b
Left (ChangeError -> Either ChangeError (TxOut era))
-> ChangeError -> Either ChangeError (TxOut era)
forall a b. (a -> b) -> a -> b
$
          ChangeError
            { $sel:inputBalance:ChangeError :: Coin
inputBalance = Coin
totalIn
            , $sel:outputBalance:ChangeError :: Coin
outputBalance = Coin
totalOut
            }
    | Bool
otherwise =
        TxOut era -> Either ChangeError (TxOut era)
forall a b. b -> Either a b
Right (TxOut era -> Either ChangeError (TxOut era))
-> TxOut era -> Either ChangeError (TxOut era)
forall a b. (a -> b) -> a -> b
$ TxOut era
feeTxOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era))
-> Coin -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
changeOut
   where
    totalOut :: Coin
totalOut = (TxOut era -> Coin) -> t (TxOut era) -> Coin
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Getting Coin (TxOut era) Coin -> TxOut era -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL) t (TxOut era)
otherOutputs Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
fee
    totalIn :: Coin
totalIn = (TxOut era -> Coin) -> t (TxOut era) -> Coin
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Getting Coin (TxOut era) Coin -> TxOut era -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL) t (TxOut era)
resolvedInputs
    changeOut :: Coin
changeOut = Coin
totalIn Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin -> Coin
forall t. Val t => t -> t
invert Coin
totalOut

  adjustRedeemers ::
    forall era.
    AlonzoEraScript era =>
    Set TxIn ->
    Set TxIn ->
    Map (PlutusPurpose AsIx era) ExUnits ->
    Redeemers era ->
    Redeemers era
  adjustRedeemers :: forall era.
AlonzoEraScript era =>
Set TxIn
-> Set TxIn
-> Map (PlutusPurpose AsIx era) ExUnits
-> Redeemers era
-> Redeemers era
adjustRedeemers Set TxIn
initialInputs Set TxIn
finalInputs Map (PlutusPurpose AsIx era) ExUnits
estimatedCosts (Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
initialRedeemers) =
    Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Redeemers era
forall a b. (a -> b) -> a -> b
$ [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PlutusPurpose AsIx era, (Data era, ExUnits))]
 -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall a b. (a -> b) -> a -> b
$ ((PlutusPurpose AsIx era, (Data era, ExUnits))
 -> (PlutusPurpose AsIx era, (Data era, ExUnits)))
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
forall a b. (a -> b) -> [a] -> [b]
map (PlutusPurpose AsIx era, (Data era, ExUnits))
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
adjustOne ([(PlutusPurpose AsIx era, (Data era, ExUnits))]
 -> [(PlutusPurpose AsIx era, (Data era, ExUnits))])
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
forall a b. (a -> b) -> a -> b
$ Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (PlutusPurpose AsIx era) (Data era, ExUnits)
initialRedeemers
   where
    sortedInputs :: [TxIn]
sortedInputs = [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
sort ([TxIn] -> [TxIn]) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> a -> b
$ Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TxIn
initialInputs
    sortedFinalInputs :: [TxIn]
sortedFinalInputs = [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
sort ([TxIn] -> [TxIn]) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> a -> b
$ Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TxIn
finalInputs
    differences :: [Int]
differences = ((TxIn, TxIn) -> Bool) -> [(TxIn, TxIn)] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
List.findIndices (Bool -> Bool
not (Bool -> Bool) -> ((TxIn, TxIn) -> Bool) -> (TxIn, TxIn) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> TxIn -> Bool) -> (TxIn, TxIn) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxIn -> TxIn -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ([(TxIn, TxIn)] -> [Int]) -> [(TxIn, TxIn)] -> [Int]
forall a b. (a -> b) -> a -> b
$ [TxIn] -> [TxIn] -> [(TxIn, TxIn)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
sortedInputs [TxIn]
sortedFinalInputs

    adjustOne :: (PlutusPurpose AsIx era, (Data era, ExUnits)) -> (PlutusPurpose AsIx era, (Data era, ExUnits))
    adjustOne :: (PlutusPurpose AsIx era, (Data era, ExUnits))
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
adjustOne (PlutusPurpose AsIx era
ptr, (Data era
d, ExUnits
_exUnits)) =
      case PlutusPurpose AsIx era
ptr of
        SpendingPurpose AsIx Word32 (TxIn (EraCrypto era))
idx
          | Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AsIx Word32 (TxIn (EraCrypto era)) -> Word32
forall ix it. AsIx ix it -> ix
unAsIx AsIx Word32 (TxIn (EraCrypto era))
idx) Int -> [Int] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Int]
differences ->
              (AsIx Word32 (TxIn (EraCrypto era)) -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxIn (EraCrypto era)) -> PlutusPurpose f era
SpendingPurpose (Word32 -> AsIx Word32 (TxIn (EraCrypto era))
forall ix it. ix -> AsIx ix it
AsIx (AsIx Word32 (TxIn (EraCrypto era)) -> Word32
forall ix it. AsIx ix it -> ix
unAsIx AsIx Word32 (TxIn (EraCrypto era))
idx Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)), (Data era
d, PlutusPurpose AsIx era -> ExUnits
executionUnitsFor PlutusPurpose AsIx era
ptr))
        PlutusPurpose AsIx era
_ ->
          (PlutusPurpose AsIx era
ptr, (Data era
d, PlutusPurpose AsIx era -> ExUnits
executionUnitsFor PlutusPurpose AsIx era
ptr))

    executionUnitsFor :: PlutusPurpose AsIx era -> ExUnits
    executionUnitsFor :: PlutusPurpose AsIx era -> ExUnits
executionUnitsFor PlutusPurpose AsIx era
ptr =
      let ExUnits Nat
maxMem Nat
maxCpu = PParams era
pparams PParams era -> Getting ExUnits (PParams era) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. Getting ExUnits (PParams era) ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
ppMaxTxExUnitsL
          ExUnits Nat
totalMem Nat
totalCpu = (ExUnits -> ExUnits)
-> Map (PlutusPurpose AsIx era) ExUnits -> ExUnits
forall m a.
Monoid m =>
(a -> m) -> Map (PlutusPurpose AsIx era) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExUnits -> ExUnits
forall a. a -> a
identity Map (PlutusPurpose AsIx era) ExUnits
estimatedCosts
          ExUnits Nat
approxMem Nat
approxCpu = Map (PlutusPurpose AsIx era) ExUnits
estimatedCosts Map (PlutusPurpose AsIx era) ExUnits
-> PlutusPurpose AsIx era -> ExUnits
forall k a. Ord k => Map k a -> k -> a
! PlutusPurpose AsIx era
ptr
       in Nat -> Nat -> ExUnits
ExUnits
            (Ratio Nat -> Nat
forall b. Integral b => Ratio Nat -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Nat
maxMem Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* Nat
approxMem Nat -> Nat -> Ratio Nat
forall a. Integral a => a -> a -> Ratio a
% Nat
totalMem))
            (Ratio Nat -> Nat
forall b. Integral b => Ratio Nat -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Nat
maxCpu Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* Nat
approxCpu Nat -> Nat -> Ratio Nat
forall a. Integral a => a -> a -> Ratio a
% Nat
totalCpu))

findLargestUTxO :: Ledger.EraTxOut era => Map TxIn (Ledger.TxOut era) -> Maybe (TxIn, Ledger.TxOut era)
findLargestUTxO :: forall era.
EraTxOut era =>
Map TxIn (TxOut era) -> Maybe (TxIn, TxOut era)
findLargestUTxO Map TxIn (TxOut era)
utxo =
  [(TxIn, TxOut era)] -> Maybe (TxIn, TxOut era)
forall a. [a] -> Maybe a
listToMaybe
    ([(TxIn, TxOut era)] -> Maybe (TxIn, TxOut era))
-> ([(TxIn, TxOut era)] -> [(TxIn, TxOut era)])
-> [(TxIn, TxOut era)]
-> Maybe (TxIn, TxOut era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, TxOut era) -> Down Coin)
-> [(TxIn, TxOut era)] -> [(TxIn, TxOut era)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Coin -> Down Coin
forall a. a -> Down a
Down (Coin -> Down Coin)
-> ((TxIn, TxOut era) -> Coin) -> (TxIn, TxOut era) -> Down Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Coin (TxOut era) Coin -> TxOut era -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL (TxOut era -> Coin)
-> ((TxIn, TxOut era) -> TxOut era) -> (TxIn, TxOut era) -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut era) -> TxOut era
forall a b. (a, b) -> b
snd)
    ([(TxIn, TxOut era)] -> Maybe (TxIn, TxOut era))
-> [(TxIn, TxOut era)] -> Maybe (TxIn, TxOut era)
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> [(TxIn, TxOut era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut era)
utxo

-- | Estimate cost of script executions on the transaction. This is only an
-- estimates because the transaction isn't sealed at this point and adding new
-- elements to it like change outputs or script integrity hash may increase that
-- cost a little.
estimateScriptsCost ::
  forall era.
  (AlonzoEraTx era, EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era, EraCrypto era ~ StandardCrypto, EraUTxO era) =>
  -- | Protocol parameters
  Core.PParams era ->
  -- | Start of the blockchain, for converting slots to UTC times
  SystemStart ->
  -- | Information about epoch sizes, for converting slots to UTC times
  EpochInfo (Either Text) ->
  -- | A UTXO needed to resolve inputs
  Map TxIn (Ledger.TxOut era) ->
  -- | The pre-constructed transaction
  Tx era ->
  Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
estimateScriptsCost :: forall era.
(AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraCrypto era ~ StandardCrypto, EraUTxO era) =>
PParams era
-> SystemStart
-> EpochInfo (Either Text)
-> Map TxIn (TxOut era)
-> Tx era
-> Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
estimateScriptsCost PParams era
pparams SystemStart
systemStart EpochInfo (Either Text)
epochInfo Map TxIn (TxOut era)
utxo Tx era
tx = do
  (PlutusPurpose AsIx era
 -> Either (TransactionScriptFailure era) ExUnits
 -> Either ErrCoverFee ExUnits)
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ExUnits)
-> Either ErrCoverFee (Map (PlutusPurpose AsIx era) ExUnits)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey PlutusPurpose AsIx era
-> Either (TransactionScriptFailure era) ExUnits
-> Either ErrCoverFee ExUnits
forall {a} {a} {b}.
(Show a, Show a) =>
a -> Either a b -> Either ErrCoverFee b
convertResult Map
  (PlutusPurpose AsIx era)
  (Either (TransactionScriptFailure era) ExUnits)
result
 where
  result ::
    Map
      (PlutusPurpose AsIx era)
      (Either (TransactionScriptFailure era) ExUnits)
  result :: Map
  (PlutusPurpose AsIx era)
  (Either (TransactionScriptFailure era) ExUnits)
result =
    PParams era
-> Tx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ExUnits)
forall era.
(AlonzoEraTx era, EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
PParams era
-> Tx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReport era
evalTxExUnits
      PParams era
pparams
      Tx era
tx
      (Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO Map (TxIn (EraCrypto era)) (TxOut era)
Map TxIn (TxOut era)
utxo)
      EpochInfo (Either Text)
epochInfo
      SystemStart
systemStart
  convertResult :: a -> Either a b -> Either ErrCoverFee b
convertResult a
ptr = \case
    Right b
exUnits -> b -> Either ErrCoverFee b
forall a b. b -> Either a b
Right b
exUnits
    Left a
failure ->
      ErrCoverFee -> Either ErrCoverFee b
forall a b. a -> Either a b
Left (ErrCoverFee -> Either ErrCoverFee b)
-> ErrCoverFee -> Either ErrCoverFee b
forall a b. (a -> b) -> a -> b
$
        ErrScriptExecutionFailed
          { $sel:redeemerPointer:ErrNotEnoughFunds :: Text
redeemerPointer = a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
ptr
          , $sel:scriptFailure:ErrNotEnoughFunds :: Text
scriptFailure = a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
failure
          }

--
-- Logs
--

data TinyWalletLog
  = BeginInitialize
  | EndInitialize {TinyWalletLog -> UTxO
initialUTxO :: Api.UTxO, TinyWalletLog -> ChainPoint
tip :: ChainPoint}
  | BeginUpdate {TinyWalletLog -> ChainPoint
point :: ChainPoint}
  | EndUpdate {TinyWalletLog -> UTxO
newUTxO :: Api.UTxO}
  | SkipUpdate {point :: ChainPoint}
  deriving stock (TinyWalletLog -> TinyWalletLog -> Bool
(TinyWalletLog -> TinyWalletLog -> Bool)
-> (TinyWalletLog -> TinyWalletLog -> Bool) -> Eq TinyWalletLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TinyWalletLog -> TinyWalletLog -> Bool
== :: TinyWalletLog -> TinyWalletLog -> Bool
$c/= :: TinyWalletLog -> TinyWalletLog -> Bool
/= :: TinyWalletLog -> TinyWalletLog -> Bool
Eq, (forall x. TinyWalletLog -> Rep TinyWalletLog x)
-> (forall x. Rep TinyWalletLog x -> TinyWalletLog)
-> Generic TinyWalletLog
forall x. Rep TinyWalletLog x -> TinyWalletLog
forall x. TinyWalletLog -> Rep TinyWalletLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TinyWalletLog -> Rep TinyWalletLog x
from :: forall x. TinyWalletLog -> Rep TinyWalletLog x
$cto :: forall x. Rep TinyWalletLog x -> TinyWalletLog
to :: forall x. Rep TinyWalletLog x -> TinyWalletLog
Generic, Int -> TinyWalletLog -> ShowS
[TinyWalletLog] -> ShowS
TinyWalletLog -> String
(Int -> TinyWalletLog -> ShowS)
-> (TinyWalletLog -> String)
-> ([TinyWalletLog] -> ShowS)
-> Show TinyWalletLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TinyWalletLog -> ShowS
showsPrec :: Int -> TinyWalletLog -> ShowS
$cshow :: TinyWalletLog -> String
show :: TinyWalletLog -> String
$cshowList :: [TinyWalletLog] -> ShowS
showList :: [TinyWalletLog] -> ShowS
Show)

deriving anyclass instance ToJSON TinyWalletLog
deriving anyclass instance FromJSON TinyWalletLog

instance Arbitrary TinyWalletLog where
  arbitrary :: Gen TinyWalletLog
arbitrary = Gen TinyWalletLog
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary
  shrink :: TinyWalletLog -> [TinyWalletLog]
shrink = TinyWalletLog -> [TinyWalletLog]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink