{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This is a module that contains functionality that is not necessary for ledger
-- operation, but is useful for testing as well as for downstream users of ledger
module Cardano.Ledger.Tools (
  -- * Tx
  setMinFeeTx,
  setMinFeeTxUtxo,
  calcMinFeeTx,
  calcMinFeeTxNativeScriptWits,
  estimateMinFeeTx,
  addDummyWitsTx,

  -- * TxOut
  setMinCoinTxOut,
  ensureMinCoinTxOut,
  setMinCoinTxOutWith,

  -- * General tools
  boom,
  integralToByteStringN,
  byteStringToNum,
)
where

import qualified Cardano.Chain.Common as Byron
import Cardano.Crypto.DSIGN.Class (sizeSigDSIGN, sizeVerKeyDSIGN)
import Cardano.Ledger.Address (BootstrapAddress (..), bootstrapKeyHash)
import Cardano.Ledger.BaseTypes (ProtVer (..))
import Cardano.Ledger.Binary (byronProtVer, decodeFull', serialize')
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Core
import Cardano.Ledger.Keys (
  BootstrapWitness (..),
  ChainCode (..),
  DSIGN,
  VKey,
  WitVKey (..),
  asWitness,
 )
import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..))
import Data.Bits (Bits (..), shiftR)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Default (def)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import Data.Proxy
import qualified Data.Set as Set
import GHC.Stack (HasCallStack)
import Lens.Micro

-- | Calculate and update the fee in the transaction until it has the smallest possible
-- value according to the settings in the protocol parameters.
--
-- This function potentially changes the `feeTxBodyL` field of the `TxBody`, as such it
-- affects the hash of the body, which consequently invalidates all of the signature in
-- the attached witnesses.
setMinFeeTx ::
  EraTx era =>
  PParams era ->
  Tx era ->
  -- | Size in bytes of reference scripts present in this transaction
  Int ->
  Tx era
setMinFeeTx :: forall era. EraTx era => PParams era -> Tx era -> Int -> Tx era
setMinFeeTx PParams era
pp Tx era
tx Int
refScriptsSize =
  forall era. EraTx era => (Tx era -> Coin) -> Tx era -> Tx era
setMinFeeTxInternal (\Tx era
t -> forall era. EraTx era => PParams era -> Tx era -> Int -> Coin
getMinFeeTx PParams era
pp Tx era
t Int
refScriptsSize) Tx era
tx

setMinFeeTxUtxo :: EraUTxO era => PParams era -> Tx era -> UTxO era -> Tx era
setMinFeeTxUtxo :: forall era.
EraUTxO era =>
PParams era -> Tx era -> UTxO era -> Tx era
setMinFeeTxUtxo PParams era
pp Tx era
tx UTxO era
utxo =
  forall era. EraTx era => (Tx era -> Coin) -> Tx era -> Tx era
setMinFeeTxInternal (\Tx era
t -> forall era.
EraUTxO era =>
PParams era -> Tx era -> UTxO era -> Coin
getMinFeeTxUtxo PParams era
pp Tx era
t UTxO era
utxo) Tx era
tx

-- | Similar to `setMinCoinTxOut` it will guarantee that the minimum requirement for the
-- output amount is satisified, however it makes it possible to set a higher amount than
-- the minimaly required.
--
-- @
-- > ensureMinCoinTxOut pp (txOut & coinTxOutL .~ zero) == setMinCoinTxOut pp (txOut & coinTxOutL .~ zero)
-- > (ensureMinCoinTxOut pp txOut ^. coinTxOutL) >= (setMinCoinTxOut pp txOut ^. coinTxOutL)
-- @
ensureMinCoinTxOut :: EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut :: forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
ensureMinCoinTxOut = forall era.
EraTxOut era =>
(Coin -> Coin -> Bool) -> PParams era -> TxOut era -> TxOut era
setMinCoinTxOutWith forall a. Ord a => a -> a -> Bool
(>=)

setMinFeeTxInternal ::
  EraTx era =>
  (Tx era -> Coin) ->
  Tx era ->
  Tx era
setMinFeeTxInternal :: forall era. EraTx era => (Tx era -> Coin) -> Tx era -> Tx era
setMinFeeTxInternal Tx era -> Coin
f Tx era
tx =
  let curMinFee :: Coin
curMinFee = Tx era -> Coin
f Tx era
tx
      curFee :: Coin
curFee = Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL
      modifiedTx :: Tx era
modifiedTx = Tx era
tx forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
curMinFee
   in if Coin
curFee forall a. Eq a => a -> a -> Bool
== Coin
curMinFee
        then Tx era
tx
        else forall era. EraTx era => (Tx era -> Coin) -> Tx era -> Tx era
setMinFeeTxInternal Tx era -> Coin
f Tx era
modifiedTx

-- | Same as `calcMinFeeTx`, except this function allows to specify hashes of key witnesses
-- that will be supplied, instead of their count. That is only useful whenever there is a
-- chance of some of the required witnesses being the same as the witnesses that will be
-- supplied for native scripts.
calcMinFeeTxNativeScriptWits ::
  forall era.
  EraUTxO era =>
  -- | All TxOuts available for this transaction. In other words `TxIn`s produced by
  -- `allInputsTxBodyF` should be present in this `UTxO` map, however this is not checked.
  UTxO era ->
  -- | The current protocol parameters.
  PParams era ->
  -- | The transaction.
  Tx era ->
  -- | KeyHash witnesses that will be supplied for satisfying native scripts. It is
  -- impossible to know how many of these is required without knowing the actual witnesses
  -- supplied and the time when the transaction will be submitted. Therefore we put this
  -- burden on the user.
  Set.Set (KeyHash 'Witness) ->
  -- | The required minimum fee.
  Coin
calcMinFeeTxNativeScriptWits :: forall era.
EraUTxO era =>
UTxO era -> PParams era -> Tx era -> Set (KeyHash 'Witness) -> Coin
calcMinFeeTxNativeScriptWits UTxO era
utxo PParams era
pp Tx era
tx Set (KeyHash 'Witness)
nativeScriptsKeyWitsHashes =
  forall era.
EraUTxO era =>
UTxO era
-> PParams era -> Tx era -> Int -> Set (KeyHash 'Witness) -> Coin
calcMinFeeTxInternal UTxO era
utxo PParams era
pp Tx era
tx (forall a. Set a -> Int
Set.size Set (KeyHash 'Witness)
nativeScriptsKeyWitsHashes) Set (KeyHash 'Witness)
nativeScriptsKeyWitsHashes

-- | This is a more accurate version `estimateMinFeeTx` that looks into transaction and
-- figures out how many and what kind of key witnesses this transaction needs. It requires
-- access to the portion of the `UTxO` that is relevant for this transaction. The only
-- type of witnesses that it cannot figure out reliably is the witnesses needed for
-- satisfying native scripts included in the transaction. For this reason number of
-- witnesses needed for native scripts must be supplied as an extra argument.
--
-- ====__Example__
--
-- >>> let relevantUtxo = txInsFilter utxo (tx ^. bodyTxL . allInputsTxBodyF)
-- >>> calcMinFeeTx relevantUtxo pp tx 5
calcMinFeeTx ::
  forall era.
  EraUTxO era =>
  -- | All TxOuts available for this transaction. In other words `TxIn`s produced by
  -- `allInputsTxBodyF` should be present in this `UTxO` map, however this is not checked.
  UTxO era ->
  -- | The current protocol parameters.
  PParams era ->
  -- | The transaction.
  Tx era ->
  -- | Number of extra KeyHash witnesses that will be supplied for satisfying native
  -- scripts. It is impossible to know how many of these is required without knowing the
  -- actual witnesses supplied and the time when the transaction will be
  -- submitted. Therefore we put this burden on the user.
  --
  -- This number can also be used to specify all of the redundant extra key witnesses that
  -- will be supplied.
  Int ->
  -- | The required minimum fee.
  Coin
calcMinFeeTx :: forall era.
EraUTxO era =>
UTxO era -> PParams era -> Tx era -> Int -> Coin
calcMinFeeTx UTxO era
utxo PParams era
pp Tx era
tx Int
extraKeyWitsCount =
  forall era.
EraUTxO era =>
UTxO era
-> PParams era -> Tx era -> Int -> Set (KeyHash 'Witness) -> Coin
calcMinFeeTxInternal UTxO era
utxo PParams era
pp Tx era
tx Int
extraKeyWitsCount forall a. Set a
Set.empty

calcMinFeeTxInternal ::
  forall era.
  EraUTxO era =>
  -- | All TxOuts available for this transaction. In other words `TxIn`s produced by
  -- `allInputsTxBodyF` should be present in this `UTxO` map, however this is not checked.
  UTxO era ->
  -- | The current protocol parameters.
  PParams era ->
  -- | The transaction.
  Tx era ->
  -- | Number of KeyHash witnesses that will be supplied for native scripts
  Int ->
  -- | KeyHash witnesses that will be supplied for native scripts
  Set.Set (KeyHash 'Witness) ->
  Coin
calcMinFeeTxInternal :: forall era.
EraUTxO era =>
UTxO era
-> PParams era -> Tx era -> Int -> Set (KeyHash 'Witness) -> Coin
calcMinFeeTxInternal UTxO era
utxo PParams era
pp Tx era
tx Int
extraKeyWitsCount Set (KeyHash 'Witness)
nativeScriptsKeyWitsHashes =
  forall era.
EraUTxO era =>
PParams era -> Tx era -> UTxO era -> Tx era
setMinFeeTxUtxo PParams era
pp Tx era
tx' UTxO era
utxo forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL
  where
    txBody :: TxBody era
txBody = Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL
    tx' :: Tx era
tx' = forall era.
EraTx era =>
PParams era
-> Tx era -> Int -> [Attributes AddrAttributes] -> Tx era
addDummyWitsTx PParams era
pp Tx era
tx Int
numKeyWitsRequired forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'Witness) (Attributes AddrAttributes)
byronAttributes
    inputs :: [TxIn]
inputs = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
spendableInputsTxBodyF
    getByronAttrs :: TxIn -> Maybe (KeyHash 'Witness, Attributes AddrAttributes)
getByronAttrs TxIn
txIn = do
      TxOut era
txOut <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
txIn forall a b. (a -> b) -> a -> b
$ forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO era
utxo
      ba :: BootstrapAddress
ba@(BootstrapAddress Address
bootAddr) <- TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
EraTxOut era =>
SimpleGetter (TxOut era) (Maybe BootstrapAddress)
bootAddrTxOutF
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (BootstrapAddress -> KeyHash 'Payment
bootstrapKeyHash BootstrapAddress
ba), Address -> Attributes AddrAttributes
Byron.addrAttributes Address
bootAddr)
    byronAttributes :: Map (KeyHash 'Witness) (Attributes AddrAttributes)
byronAttributes = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxIn -> Maybe (KeyHash 'Witness, Attributes AddrAttributes)
getByronAttrs [TxIn]
inputs
    requiredKeyHashes :: Set (KeyHash 'Witness)
requiredKeyHashes =
      forall era.
EraUTxO era =>
CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getWitsVKeyNeeded forall a. Default a => a
def UTxO era
utxo TxBody era
txBody forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set (KeyHash 'Witness)
nativeScriptsKeyWitsHashes
    numKeyWitsRequired :: Int
numKeyWitsRequired =
      forall era. EraTxBody era => TxBody era -> Int
getGenesisKeyHashCountTxBody TxBody era
txBody
        forall a. Num a => a -> a -> a
+ Int
extraKeyWitsCount
        forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
Set.size (Set (KeyHash 'Witness)
requiredKeyHashes forall a. Ord a => Set a -> Set a -> Set a
Set.\\ forall k a. Map k a -> Set k
Map.keysSet Map (KeyHash 'Witness) (Attributes AddrAttributes)
byronAttributes)

-- | Estimate a minimum transaction fee for a transaction that does not yet have all of
-- the `VKey` witnesses. This calculation is not very accurate in estimating Byron
-- witnesses, but it should work for the most part. If you have access to UTxO necessary
-- for the transaction that it is better and easier to use `calcMinFeeTx` instead.
--
-- @since 1.8.0
estimateMinFeeTx ::
  forall era.
  EraTx era =>
  -- | The current protocol parameters.
  PParams era ->
  -- | The transaction.
  Tx era ->
  -- | The number of key witnesses still to be added to the transaction.
  Int ->
  -- | The number of Byron key witnesses still to be added to the transaction.
  Int ->
  -- | The total size in bytes of reference scripts
  Int ->
  -- | The required minimum fee.
  Coin
estimateMinFeeTx :: forall era.
EraTx era =>
PParams era -> Tx era -> Int -> Int -> Int -> Coin
estimateMinFeeTx PParams era
pp Tx era
tx Int
numKeyWits Int
numByronKeyWits Int
refScriptsSize =
  forall era. EraTx era => PParams era -> Tx era -> Int -> Tx era
setMinFeeTx PParams era
pp Tx era
tx' Int
refScriptsSize forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL
  where
    tx' :: Tx era
tx' = forall era.
EraTx era =>
PParams era
-> Tx era -> Int -> [Attributes AddrAttributes] -> Tx era
addDummyWitsTx PParams era
pp Tx era
tx Int
numKeyWits forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
numByronKeyWits Attributes AddrAttributes
dummyByronAttributes
    -- We assume testnet network magic here to avoid having to thread the actual network
    -- ID into this function merely to calculate the fees of byron witnesses more
    -- accurately. This will over-estimate min fees for byron witnesses in mainnet
    -- transaction by 7 bytes per witness.
    dummyByronAttributes :: Attributes AddrAttributes
dummyByronAttributes =
      forall h. h -> Attributes h
Byron.mkAttributes
        Byron.AddrAttributes
          { aaVKDerivationPath :: Maybe HDAddressPayload
Byron.aaVKDerivationPath = forall a. Maybe a
Nothing
          , aaNetworkMagic :: NetworkMagic
Byron.aaNetworkMagic = Word32 -> NetworkMagic
Byron.NetworkTestnet forall a. Bounded a => a
maxBound
          }

integralToByteStringN :: (Integral i, Bits i) => Int -> i -> ByteString
integralToByteStringN :: forall i. (Integral i, Bits i) => Int -> i -> ByteString
integralToByteStringN Int
len = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
len (\i
n -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n, i
n forall a. Bits a => a -> Int -> a
`shiftR` Int
8))

byteStringToNum :: (Bits i, Num i) => ByteString -> i
byteStringToNum :: forall i. (Bits i, Num i) => ByteString -> i
byteStringToNum = forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr (\Word8
w i
i -> i
i forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) i
0

-- | Create dummy witnesses and add them to the transaction
addDummyWitsTx ::
  forall era.
  EraTx era =>
  -- | The current protocol parameters.
  PParams era ->
  -- | The transaction.
  Tx era ->
  -- | The number of key witnesses still to be added to the transaction.
  Int ->
  -- | List of attributes from TxOuts with Byron addresses that are being spent
  [Byron.Attributes Byron.AddrAttributes] ->
  -- | The required minimum fee.
  Tx era
addDummyWitsTx :: forall era.
EraTx era =>
PParams era
-> Tx era -> Int -> [Attributes AddrAttributes] -> Tx era
addDummyWitsTx PParams era
pp Tx era
tx Int
numKeyWits [Attributes AddrAttributes]
byronAttrs =
  Tx era
tx
    forall a b. a -> (a -> b) -> b
& (forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Set (WitVKey 'Witness)
dummyKeyWits)
    forall a b. a -> (a -> b) -> b
& (forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
bootAddrTxWitsL forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Set BootstrapWitness
dummyByronKeyWits)
  where
    dsign :: Proxy DSIGN
    dsign :: Proxy DSIGN
dsign = forall {k} (t :: k). Proxy t
Proxy
    version :: Version
version = ProtVer -> Version
pvMajor (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)
    -- We need to make sure that dummies are unique, since they'll be placed into a Set
    mkDummy :: [Char] -> Int -> a -> c
mkDummy [Char]
name Int
n =
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (\DecoderError
err -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Corrupt Dummy " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show DecoderError
err))
        forall a. a -> a
id
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
version
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. (Integral i, Bits i) => Int -> i -> ByteString
integralToByteStringN Int
n
    vKeySize :: Int
vKeySize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN Proxy DSIGN
dsign
    dummyKeys :: [VKey 'Witness]
dummyKeys = forall a b. (a -> b) -> [a] -> [b]
map (forall {c} {a}.
(DecCBOR c, Integral a, Bits a) =>
[Char] -> Int -> a -> c
mkDummy [Char]
"VKey" Int
vKeySize) [Int
0 :: Int ..]

    sigSize :: Int
sigSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN Proxy DSIGN
dsign
    dummySig :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
dummySig = forall {c} {a}.
(DecCBOR c, Integral a, Bits a) =>
[Char] -> Int -> a -> c
mkDummy [Char]
"Signature" Int
sigSize (Int
0 :: Int)
    dummyKeyWits :: Set (WitVKey 'Witness)
dummyKeyWits =
      forall a. Ord a => [a] -> Set a
Set.fromList [forall (kr :: KeyRole).
Typeable kr =>
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
WitVKey VKey 'Witness
key SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
dummySig | VKey 'Witness
key <- forall a. Int -> [a] -> [a]
take Int
numKeyWits [VKey 'Witness]
dummyKeys]

    -- ChainCode is always 32 bytes long.
    chainCode :: ChainCode
chainCode = ByteString -> ChainCode
ChainCode forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0

    mkDummyByronKeyWit ::
      VKey 'Witness ->
      Byron.Attributes Byron.AddrAttributes ->
      BootstrapWitness
    mkDummyByronKeyWit :: VKey 'Witness -> Attributes AddrAttributes -> BootstrapWitness
mkDummyByronKeyWit VKey 'Witness
key =
      VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness
BootstrapWitness VKey 'Witness
key SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
dummySig ChainCode
chainCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer
    dummyByronKeyWits :: Set BootstrapWitness
dummyByronKeyWits =
      forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VKey 'Witness -> Attributes AddrAttributes -> BootstrapWitness
mkDummyByronKeyWit [VKey 'Witness]
dummyKeys [Attributes AddrAttributes]
byronAttrs

-- | Same as `setMinCoinSizedTxOut`, except it doesn't require the size of the
-- TxOut and will recompute it if needed. Initial amount is not important.
setMinCoinTxOut :: EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut :: forall era. EraTxOut era => PParams era -> TxOut era -> TxOut era
setMinCoinTxOut = forall era.
EraTxOut era =>
(Coin -> Coin -> Bool) -> PParams era -> TxOut era -> TxOut era
setMinCoinTxOutWith forall a. Eq a => a -> a -> Bool
(==)

setMinCoinTxOutWith ::
  EraTxOut era =>
  (Coin -> Coin -> Bool) ->
  PParams era ->
  TxOut era ->
  TxOut era
setMinCoinTxOutWith :: forall era.
EraTxOut era =>
(Coin -> Coin -> Bool) -> PParams era -> TxOut era -> TxOut era
setMinCoinTxOutWith Coin -> Coin -> Bool
f PParams era
pp = TxOut era -> TxOut era
go
  where
    go :: TxOut era -> TxOut era
go !TxOut era
txOut =
      let curMinCoin :: Coin
curMinCoin = forall era. EraTxOut era => PParams era -> TxOut era -> Coin
getMinCoinTxOut PParams era
pp TxOut era
txOut
          curCoin :: Coin
curCoin = TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL
       in if Coin
curCoin Coin -> Coin -> Bool
`f` Coin
curMinCoin
            then TxOut era
txOut
            else TxOut era -> TxOut era
go (TxOut era
txOut forall a b. a -> (a -> b) -> b
& forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
curMinCoin)

-- | A helpful placeholder to use during development.
boom :: HasCallStack => a
boom :: forall a. HasCallStack => a
boom = forall a. HasCallStack => [Char] -> a
error [Char]
"Unimplemented"
{-# WARNING boom "BOOM!" #-}