{-# 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.State (EraCertState)
import Cardano.Ledger.State.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 TopTx era ->
  -- | Size in bytes of reference scripts present in this transaction
  Int ->
  Tx TopTx era
setMinFeeTx :: forall era.
EraTx era =>
PParams era -> Tx TopTx era -> Int -> Tx TopTx era
setMinFeeTx PParams era
pp Tx TopTx era
tx Int
refScriptsSize =
  (Tx TopTx era -> Coin) -> Tx TopTx era -> Tx TopTx era
forall era.
EraTx era =>
(Tx TopTx era -> Coin) -> Tx TopTx era -> Tx TopTx era
setMinFeeTxInternal (\Tx TopTx era
t -> PParams era -> Tx TopTx era -> Int -> Coin
forall era (l :: TxLevel).
EraTx era =>
PParams era -> Tx l era -> Int -> Coin
forall (l :: TxLevel). PParams era -> Tx l era -> Int -> Coin
getMinFeeTx PParams era
pp Tx TopTx era
t Int
refScriptsSize) Tx TopTx era
tx

setMinFeeTxUtxo :: EraUTxO era => PParams era -> Tx TopTx era -> UTxO era -> Tx TopTx era
setMinFeeTxUtxo :: forall era.
EraUTxO era =>
PParams era -> Tx TopTx era -> UTxO era -> Tx TopTx era
setMinFeeTxUtxo PParams era
pp Tx TopTx era
tx UTxO era
utxo =
  (Tx TopTx era -> Coin) -> Tx TopTx era -> Tx TopTx era
forall era.
EraTx era =>
(Tx TopTx era -> Coin) -> Tx TopTx era -> Tx TopTx era
setMinFeeTxInternal (\Tx TopTx era
t -> PParams era -> Tx TopTx era -> UTxO era -> Coin
forall era (t :: TxLevel).
EraUTxO era =>
PParams era -> Tx t era -> UTxO era -> Coin
forall (t :: TxLevel). PParams era -> Tx t era -> UTxO era -> Coin
getMinFeeTxUtxo PParams era
pp Tx TopTx era
t UTxO era
utxo) Tx TopTx 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 = (Coin -> Coin -> Bool) -> PParams era -> TxOut era -> TxOut era
forall era.
EraTxOut era =>
(Coin -> Coin -> Bool) -> PParams era -> TxOut era -> TxOut era
setMinCoinTxOutWith Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
(>=)

setMinFeeTxInternal ::
  EraTx era =>
  (Tx TopTx era -> Coin) ->
  Tx TopTx era ->
  Tx TopTx era
setMinFeeTxInternal :: forall era.
EraTx era =>
(Tx TopTx era -> Coin) -> Tx TopTx era -> Tx TopTx era
setMinFeeTxInternal Tx TopTx era -> Coin
f Tx TopTx era
tx =
  let curMinFee :: Coin
curMinFee = Tx TopTx era -> Coin
f Tx TopTx era
tx
      curFee :: Coin
curFee = Tx TopTx era
tx Tx TopTx era -> Getting Coin (Tx TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Tx TopTx era -> Const Coin (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Coin (TxBody TopTx era))
 -> Tx TopTx era -> Const Coin (Tx TopTx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Getting Coin (Tx TopTx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx era -> Const Coin (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL
      modifiedTx :: Tx TopTx era
modifiedTx = Tx TopTx era
tx Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Coin -> Identity Coin)
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (Coin -> Identity Coin)
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Coin -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
curMinFee
   in if Coin
curFee Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
curMinFee
        then Tx TopTx era
tx
        else (Tx TopTx era -> Coin) -> Tx TopTx era -> Tx TopTx era
forall era.
EraTx era =>
(Tx TopTx era -> Coin) -> Tx TopTx era -> Tx TopTx era
setMinFeeTxInternal Tx TopTx era -> Coin
f Tx TopTx 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, EraCertState 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 TopTx 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, EraCertState era) =>
UTxO era
-> PParams era -> Tx TopTx era -> Set (KeyHash Witness) -> Coin
calcMinFeeTxNativeScriptWits UTxO era
utxo PParams era
pp Tx TopTx era
tx Set (KeyHash Witness)
nativeScriptsKeyWitsHashes =
  UTxO era
-> PParams era
-> Tx TopTx era
-> Int
-> Set (KeyHash Witness)
-> Coin
forall era.
(EraUTxO era, EraCertState era) =>
UTxO era
-> PParams era
-> Tx TopTx era
-> Int
-> Set (KeyHash Witness)
-> Coin
calcMinFeeTxInternal UTxO era
utxo PParams era
pp Tx TopTx era
tx (Set (KeyHash Witness) -> Int
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, EraCertState 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 TopTx 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, EraCertState era) =>
UTxO era -> PParams era -> Tx TopTx era -> Int -> Coin
calcMinFeeTx UTxO era
utxo PParams era
pp Tx TopTx era
tx Int
extraKeyWitsCount =
  UTxO era
-> PParams era
-> Tx TopTx era
-> Int
-> Set (KeyHash Witness)
-> Coin
forall era.
(EraUTxO era, EraCertState era) =>
UTxO era
-> PParams era
-> Tx TopTx era
-> Int
-> Set (KeyHash Witness)
-> Coin
calcMinFeeTxInternal UTxO era
utxo PParams era
pp Tx TopTx era
tx Int
extraKeyWitsCount Set (KeyHash Witness)
forall a. Set a
Set.empty

calcMinFeeTxInternal ::
  forall era.
  (EraUTxO era, EraCertState 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 TopTx 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, EraCertState era) =>
UTxO era
-> PParams era
-> Tx TopTx era
-> Int
-> Set (KeyHash Witness)
-> Coin
calcMinFeeTxInternal UTxO era
utxo PParams era
pp Tx TopTx era
tx Int
extraKeyWitsCount Set (KeyHash Witness)
nativeScriptsKeyWitsHashes =
  PParams era -> Tx TopTx era -> UTxO era -> Tx TopTx era
forall era.
EraUTxO era =>
PParams era -> Tx TopTx era -> UTxO era -> Tx TopTx era
setMinFeeTxUtxo PParams era
pp Tx TopTx era
tx' UTxO era
utxo Tx TopTx era -> Getting Coin (Tx TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Tx TopTx era -> Const Coin (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Coin (TxBody TopTx era))
 -> Tx TopTx era -> Const Coin (Tx TopTx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Getting Coin (Tx TopTx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx era -> Const Coin (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL
  where
    txBody :: TxBody TopTx era
txBody = Tx TopTx era
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
    tx' :: Tx TopTx era
tx' = PParams era
-> Tx TopTx era
-> Int
-> [Attributes AddrAttributes]
-> Tx TopTx era
forall era (l :: TxLevel).
EraTx era =>
PParams era
-> Tx l era -> Int -> [Attributes AddrAttributes] -> Tx l era
addDummyWitsTx PParams era
pp Tx TopTx era
tx Int
numKeyWitsRequired ([Attributes AddrAttributes] -> Tx TopTx era)
-> [Attributes AddrAttributes] -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$ Map (KeyHash Witness) (Attributes AddrAttributes)
-> [Attributes AddrAttributes]
forall k a. Map k a -> [a]
Map.elems Map (KeyHash Witness) (Attributes AddrAttributes)
byronAttributes
    inputs :: [TxIn]
inputs = Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (Set TxIn -> [TxIn]) -> Set TxIn -> [TxIn]
forall a b. (a -> b) -> a -> b
$ TxBody TopTx era
txBody TxBody TopTx era
-> Getting (Set TxIn) (TxBody TopTx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx era) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
SimpleGetter (TxBody l era) (Set TxIn)
forall (l :: TxLevel). SimpleGetter (TxBody l era) (Set TxIn)
spendableInputsTxBodyF
    getByronAttrs :: TxIn -> Maybe (KeyHash Witness, Attributes AddrAttributes)
getByronAttrs TxIn
txIn = do
      txOut <- TxIn -> Map TxIn (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
txIn (Map TxIn (TxOut era) -> Maybe (TxOut era))
-> Map TxIn (TxOut era) -> Maybe (TxOut era)
forall a b. (a -> b) -> a -> b
$ UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO era
utxo
      ba@(BootstrapAddress bootAddr) <- txOut ^. bootAddrTxOutF
      pure (asWitness (bootstrapKeyHash ba), Byron.addrAttributes bootAddr)
    byronAttributes :: Map (KeyHash Witness) (Attributes AddrAttributes)
byronAttributes = [(KeyHash Witness, Attributes AddrAttributes)]
-> Map (KeyHash Witness) (Attributes AddrAttributes)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash Witness, Attributes AddrAttributes)]
 -> Map (KeyHash Witness) (Attributes AddrAttributes))
-> [(KeyHash Witness, Attributes AddrAttributes)]
-> Map (KeyHash Witness) (Attributes AddrAttributes)
forall a b. (a -> b) -> a -> b
$ (TxIn -> Maybe (KeyHash Witness, Attributes AddrAttributes))
-> [TxIn] -> [(KeyHash Witness, Attributes AddrAttributes)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxIn -> Maybe (KeyHash Witness, Attributes AddrAttributes)
getByronAttrs [TxIn]
inputs
    requiredKeyHashes :: Set (KeyHash Witness)
requiredKeyHashes =
      CertState era
-> UTxO era -> TxBody TopTx era -> Set (KeyHash Witness)
forall era (t :: TxLevel).
EraUTxO era =>
CertState era -> UTxO era -> TxBody t era -> Set (KeyHash Witness)
forall (t :: TxLevel).
CertState era -> UTxO era -> TxBody t era -> Set (KeyHash Witness)
getWitsVKeyNeeded CertState era
forall a. Default a => a
def UTxO era
utxo TxBody TopTx era
txBody Set (KeyHash Witness)
-> Set (KeyHash Witness) -> Set (KeyHash Witness)
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set (KeyHash Witness)
nativeScriptsKeyWitsHashes
    numKeyWitsRequired :: Int
numKeyWitsRequired =
      TxBody TopTx era -> Int
forall era. EraTxBody era => TxBody TopTx era -> Int
getGenesisKeyHashCountTxBody TxBody TopTx era
txBody
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extraKeyWitsCount
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set (KeyHash Witness) -> Int
forall a. Set a -> Int
Set.size (Set (KeyHash Witness)
requiredKeyHashes Set (KeyHash Witness)
-> Set (KeyHash Witness) -> Set (KeyHash Witness)
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Map (KeyHash Witness) (Attributes AddrAttributes)
-> Set (KeyHash Witness)
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 TopTx 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 TopTx era -> Int -> Int -> Int -> Coin
estimateMinFeeTx PParams era
pp Tx TopTx era
tx Int
numKeyWits Int
numByronKeyWits Int
refScriptsSize =
  PParams era -> Tx TopTx era -> Int -> Tx TopTx era
forall era.
EraTx era =>
PParams era -> Tx TopTx era -> Int -> Tx TopTx era
setMinFeeTx PParams era
pp Tx TopTx era
tx' Int
refScriptsSize Tx TopTx era -> Getting Coin (Tx TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Tx TopTx era -> Const Coin (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Coin (TxBody TopTx era))
 -> Tx TopTx era -> Const Coin (Tx TopTx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Getting Coin (Tx TopTx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx era -> Const Coin (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL
  where
    tx' :: Tx TopTx era
tx' = PParams era
-> Tx TopTx era
-> Int
-> [Attributes AddrAttributes]
-> Tx TopTx era
forall era (l :: TxLevel).
EraTx era =>
PParams era
-> Tx l era -> Int -> [Attributes AddrAttributes] -> Tx l era
addDummyWitsTx PParams era
pp Tx TopTx era
tx Int
numKeyWits ([Attributes AddrAttributes] -> Tx TopTx era)
-> [Attributes AddrAttributes] -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$ Int -> Attributes AddrAttributes -> [Attributes AddrAttributes]
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 =
      AddrAttributes -> Attributes AddrAttributes
forall h. h -> Attributes h
Byron.mkAttributes
        Byron.AddrAttributes
          { aaVKDerivationPath :: Maybe HDAddressPayload
Byron.aaVKDerivationPath = Maybe HDAddressPayload
forall a. Maybe a
Nothing
          , aaNetworkMagic :: NetworkMagic
Byron.aaNetworkMagic = Word32 -> NetworkMagic
Byron.NetworkTestnet Word32
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 = (ByteString, Maybe i) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe i) -> ByteString)
-> (i -> (ByteString, Maybe i)) -> i -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (i -> Maybe (Word8, i)) -> i -> (ByteString, Maybe i)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
len (\i
n -> (Word8, i) -> Maybe (Word8, i)
forall a. a -> Maybe a
Just (i -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n, i
n i -> Int -> i
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 = (Word8 -> i -> i) -> i -> ByteString -> i
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr (\Word8
w i
i -> i
i i -> Int -> i
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 i -> i -> i
forall a. Num a => a -> a -> a
+ Word8 -> i
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 l.
  EraTx era =>
  -- | The current protocol parameters.
  PParams era ->
  -- | The transaction.
  Tx l 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 l era
addDummyWitsTx :: forall era (l :: TxLevel).
EraTx era =>
PParams era
-> Tx l era -> Int -> [Attributes AddrAttributes] -> Tx l era
addDummyWitsTx PParams era
pp Tx l era
tx Int
numKeyWits [Attributes AddrAttributes]
byronAttrs =
  Tx l era
tx
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& ((TxWits era -> Identity (TxWits era))
-> Tx l era -> Identity (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx l era -> Identity (Tx l era))
-> ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits era) (Set (WitVKey Witness))
addrTxWitsL ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> Tx l era -> Identity (Tx l era))
-> Set (WitVKey Witness) -> Tx l era -> Tx l era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Set (WitVKey Witness)
dummyKeyWits)
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& ((TxWits era -> Identity (TxWits era))
-> Tx l era -> Identity (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx l era -> Identity (Tx l era))
-> ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
    -> TxWits era -> Identity (TxWits era))
-> (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits era) (Set BootstrapWitness)
bootAddrTxWitsL ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
 -> Tx l era -> Identity (Tx l era))
-> Set BootstrapWitness -> Tx l era -> Tx l era
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 = Proxy DSIGN
forall {k} (t :: k). Proxy t
Proxy
    version :: Version
version = ProtVer -> Version
pvMajor (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
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 =
      (DecoderError -> c) -> (c -> c) -> Either DecoderError c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (\DecoderError
err -> [Char] -> c
forall a. HasCallStack => [Char] -> a
error ([Char]
"Corrupt Dummy " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DecoderError -> [Char]
forall a. Show a => a -> [Char]
show DecoderError
err))
        c -> c
forall a. a -> a
id
        (Either DecoderError c -> c)
-> (a -> Either DecoderError c) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> ByteString -> Either DecoderError c
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
version
        (ByteString -> Either DecoderError c)
-> (a -> ByteString) -> a -> Either DecoderError c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> ByteString -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version
        (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ByteString
forall i. (Integral i, Bits i) => Int -> i -> ByteString
integralToByteStringN Int
n
    vKeySize :: Int
vKeySize = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN Proxy DSIGN
dsign
    dummyKeys :: [VKey Witness]
dummyKeys = (Int -> VKey Witness) -> [Int] -> [VKey Witness]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int -> Int -> VKey Witness
forall {c} {a}.
(DecCBOR c, Integral a, Bits a) =>
[Char] -> Int -> a -> c
mkDummy [Char]
"VKey" Int
vKeySize) [Int
0 :: Int ..]

    sigSize :: Int
sigSize = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN Proxy DSIGN
dsign
    dummySig :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
dummySig = [Char]
-> Int -> Int -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
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 =
      [WitVKey Witness] -> Set (WitVKey Witness)
forall a. Ord a => [a] -> Set a
Set.fromList [VKey Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> WitVKey Witness
forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
WitVKey VKey Witness
key SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
dummySig | VKey Witness
key <- Int -> [VKey Witness] -> [VKey Witness]
forall a. Int -> [a] -> [a]
take Int
numKeyWits [VKey Witness]
dummyKeys]

    -- ChainCode is always 32 bytes long.
    chainCode :: ChainCode
chainCode = ByteString -> ChainCode
ChainCode (ByteString -> ChainCode) -> ByteString -> 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 (ByteString -> BootstrapWitness)
-> (Attributes AddrAttributes -> ByteString)
-> Attributes AddrAttributes
-> BootstrapWitness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Attributes AddrAttributes -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer
    dummyByronKeyWits :: Set BootstrapWitness
dummyByronKeyWits =
      [BootstrapWitness] -> Set BootstrapWitness
forall a. Ord a => [a] -> Set a
Set.fromList ([BootstrapWitness] -> Set BootstrapWitness)
-> [BootstrapWitness] -> Set BootstrapWitness
forall a b. (a -> b) -> a -> b
$ (VKey Witness -> Attributes AddrAttributes -> BootstrapWitness)
-> [VKey Witness]
-> [Attributes AddrAttributes]
-> [BootstrapWitness]
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 = (Coin -> Coin -> Bool) -> PParams era -> TxOut era -> TxOut era
forall era.
EraTxOut era =>
(Coin -> Coin -> Bool) -> PParams era -> TxOut era -> TxOut era
setMinCoinTxOutWith Coin -> Coin -> Bool
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 = PParams era -> TxOut era -> Coin
forall era. EraTxOut era => PParams era -> TxOut era -> Coin
getMinCoinTxOut PParams era
pp TxOut era
txOut
          curCoin :: Coin
curCoin = TxOut era
txOut TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
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 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
curMinCoin)

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