From 3fd306fb4c66013ab92c689fd8ae9799e4bc0016 Mon Sep 17 00:00:00 2001 From: vvtran Date: Mon, 17 Jan 2022 13:51:25 +0000 Subject: [PATCH] add many helpers to calculate size from Mary era --- spago.dhall | 1 + src/PreBalanceTx.purs | 95 +++++++++++++++++++++++++++++-- src/ProtocolParametersAlonzo.purs | 20 ++++++- src/Types/Value.purs | 36 ++++++++++-- 4 files changed, 143 insertions(+), 9 deletions(-) diff --git a/spago.dhall b/spago.dhall index cb97a44e21..8b991b74f4 100644 --- a/spago.dhall +++ b/spago.dhall @@ -30,6 +30,7 @@ You can edit this file as you like. , "psci-support" , "refs" , "spec" + , "strings" , "these" , "transformers" , "tuples" diff --git a/src/PreBalanceTx.purs b/src/PreBalanceTx.purs index 92e8d05089..704fef98ae 100644 --- a/src/PreBalanceTx.purs +++ b/src/PreBalanceTx.purs @@ -7,24 +7,26 @@ import Prelude import Control.Monad.Reader.Trans (runReaderT) import Control.Monad.Trans.Class (lift) import Data.Array as Array -import Data.BigInt (BigInt, fromInt) +import Data.BigInt (BigInt, fromInt, quot) import Data.Either (Either(..), fromRight, hush, isRight, note) import Data.Foldable as Foldable import Data.List ((:), List(..), partition) import Data.Map as Map -import Data.Maybe (fromMaybe, Maybe(..)) +import Data.Map (values, unions) +import Data.Maybe (fromMaybe, maybe, Maybe(..)) import Data.Newtype (over, unwrap, wrap) import Data.Set (Set) import Data.Set as Set +import Data.String.CodeUnits (length) import Data.Tuple.Nested ((/\), type (/\)) import Effect.Aff (Aff) import Undefined (undefined) import Ogmios (QueryConfig, QueryM(..)) -import ProtocolParametersAlonzo (protocolParamUTxOCostPerWord) +import ProtocolParametersAlonzo (lovelacePerUTxOWord, pidSize, protocolParamUTxOCostPerWord, Word(..)) import Types.Ada (adaSymbol, fromValue, getLovelace, lovelaceValueOf) import Types.Transaction (Address, Credential(..), RequiredSigner, Transaction(..), TransactionInput, TransactionOutput(..), TxBody(..), Utxo, UtxoM) -import Types.Value (emptyValue, flattenValue, geq, getValue, isAdaOnly, isPos, isZero, minus, Value(..)) +import Types.Value (allTokenNames, emptyValue, flattenValue, geq, getValue, isAdaOnly, isPos, isZero, minus, numCurrencySymbols, numTokenNames, Value(..)) -- This module replicates functionality from -- https://github.com/mlabs-haskell/mlabs-pab/blob/master/src/MLabsPAB/PreBalance.hs @@ -58,6 +60,91 @@ preBalanceTxM qConfig ownAddr addReqSigners requiredAddrs unbalancedTx = requiredAddrs unwrapUnbalancedTx.body qConfig +-- where +-- loop :: +-- Utxo -> +-- Map.Map Address RequiredSigner -> +-- Array Address -> +-- Array (TransactionOutput /\ BigInt) -> +-- Transaction -> +-- QueryM (Either String Transaction) +-- loop utxoIndex addReqSigners requiredAddrs prevMinUtxos tx = do +-- void $ lift $ Files.writeAll @w pabConf tx +-- nextMinUtxos <- +-- newEitherT $ +-- calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos + +-- let minUtxos = prevMinUtxos ++ nextMinUtxos + +-- lift $ printLog @w Debug $ "Min utxos: " ++ show minUtxos + +-- txWithoutFees <- +-- hoistEither $ preBalanceTx pabConf.pcProtocolParams minUtxos 0 utxoIndex ownPkh privKeys requiredSigs tx + +-- lift $ createDirectoryIfMissing @w False (Text.unpack pabConf.pcTxFileDir) +-- lift $ CardanoCLI.buildTx @w pabConf ownPkh (CardanoCLI.BuildRaw 0) txWithoutFees +-- fees <- newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees + +-- lift $ printLog @w Debug $ "Fees: " ++ show fees + +-- balancedTx <- hoistEither $ preBalanceTx pabConf.pcProtocolParams minUtxos fees utxoIndex ownPkh privKeys requiredSigs tx + +-- if balancedTx == tx +-- then pure balancedTx +-- else loop utxoIndex privKeys requiredSigs minUtxos balancedTx + +-- calculateMinUtxos :: +-- forall (w :: Type) (effs :: [Type -> Type]). +-- Member (PABEffect w) effs => +-- PABConfig -> +-- Map DatumHash Datum -> +-- [TxOut] -> +-- Eff effs (Either Text [(TxOut, Integer)]) +-- calculateMinUtxos pabConf datums txOuts = +-- zipWithM (fmap . (,)) txOuts <$> mapM (CardanoCLI.calculateMinUtxo @w pabConf datums) txOuts + +-- https://cardano-ledger.readthedocs.io/en/latest/explanations/min-utxo-mary.html +-- https://github.com/input-output-hk/cardano-ledger/blob/master/doc/explanations/min-utxo-alonzo.rst +-- https://github.com/cardano-foundation/CIPs/tree/master/CIP-0028#rationale-for-parameter-choices +-- | Given an array of transaction outputs, return the paired amount of lovelaces +-- | required by each utxo. +-- calculateMinUtxo +-- :: Array TransactionOutput +-- -> Array (Either String (TransactionOutput /\ BigInt)) +-- calculateMinUtxo txOuts = + +-- https://github.com/input-output-hk/cardano-ledger/blob/master/doc/explanations/min-utxo-alonzo.rst +-- | Calculates how many words are needed depending on whether the datum is +-- | hashed or not. 10 words for a hashed datum and 0 for no hash. The argument +-- | to the function is the datum hash found in TransactionOutput. +dataHashSize :: Maybe String -> Word -- Should we add type safety? +dataHashSize Nothing = Word zero +dataHashSize (Just _) = Word $ fromInt 10 + +-- https://cardano-ledger.readthedocs.io/en/latest/explanations/min-utxo-mary.html +-- FIX ME: Is this correct? The formula is actually based on the length of the +-- bytestring representation, but we are using strings. +-- | Sum of the length of the strings of distinct token names. +sumTokenNameLengths :: Value -> BigInt +sumTokenNameLengths = Foldable.foldl lenAdd zero <<< allTokenNames + where + lenAdd :: BigInt -> TokenName -> BigInt + lenAdd = \b a -> b + fromInt (length $ unwrap a) + +-- https://cardano-ledger.readthedocs.io/en/latest/explanations/min-utxo-mary.html +-- See "size" +size :: Value -> BigInt +size v = fromInt 6 + roundupBytesToWords b + where + b :: BigInt + b = numTokenNames v * fromInt 12 + + sumTokenNameLengths v + + numCurrencySymbols v * pidSize + +-- https://cardano-ledger.readthedocs.io/en/latest/explanations/min-utxo-mary.html +-- | converts bytes to 8-byte long words, rounding up +roundupBytesToWords :: BigInt -> BigInt +roundupBytesToWords b = quot (b + (fromInt 7)) $ fromInt 8 preBalanceTx :: Array (TransactionOutput /\ BigInt) diff --git a/src/ProtocolParametersAlonzo.purs b/src/ProtocolParametersAlonzo.purs index df05608fd9..6c7ace20d4 100644 --- a/src/ProtocolParametersAlonzo.purs +++ b/src/ProtocolParametersAlonzo.purs @@ -1,13 +1,23 @@ module ProtocolParametersAlonzo ( lovelacePerUTxOWord + , pidSize , protocolParamUTxOCostPerWord + , Word(..) ) where import Prelude -import Data.BigInt (fromInt) +import Data.BigInt (BigInt, fromInt) +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype) import Types.Ada (Ada(..)) +newtype Word = Word BigInt +derive instance eqWord :: Eq Word +derive instance newtypeWord :: Newtype Word _ +derive instance ordWord :: Ord Word +derive newtype instance showWord :: Show Word + -- https://playground.plutus.iohkdev.io/doc/haddock/plutus-pab/html/src/Cardano.Api.ProtocolParameters.html -- Shelley params, is this unchanged? protocolParamUTxOCostPerWord :: Ada @@ -16,3 +26,11 @@ protocolParamUTxOCostPerWord = Lovelace $ fromInt 1 -- https://github.com/cardano-foundation/CIPs/tree/master/CIP-0028 lovelacePerUTxOWord :: Ada lovelacePerUTxOWord = Lovelace $ fromInt 34482 + +-- https://github.com/input-output-hk/cardano-ledger/blob/master/doc/explanations/min-utxo-alonzo.rst +utxoEntrySizeWithoutVal :: Word +utxoEntrySizeWithoutVal = Word $ fromInt 27 + +-- https://cardano-ledger.readthedocs.io/en/latest/explanations/min-utxo-mary.html +pidSize :: BigInt +pidSize = fromInt 28 \ No newline at end of file diff --git a/src/Types/Value.purs b/src/Types/Value.purs index fb982aa0c7..5c91297fbe 100644 --- a/src/Types/Value.purs +++ b/src/Types/Value.purs @@ -2,6 +2,7 @@ module Types.Value ( CurrencySymbol(..) , TokenName(..) , Value(..) + , allTokenNames , emptyValue , eq , flattenValue @@ -14,6 +15,10 @@ module Types.Value , leq , lt , minus + , numCurrencySymbols + , numCurrencySymbols' + , numTokenNames + , numTokenNames' , singleton , unflattenValue , valueOf @@ -23,14 +28,15 @@ module Types.Value import Prelude import Control.Alternative (guard) import Data.Array (filter) -import Data.BigInt (BigInt) -import Data.Foldable (any) +import Data.BigInt (BigInt, fromInt) +import Data.Foldable (any, length) import Data.Generic.Rep (class Generic) import Data.List ((:), all, foldMap, List(..)) -import Data.Map (lookup, Map, toUnfoldable) +import Data.Map (keys, lookup, Map, toUnfoldable, unions, values) import Data.Map as Map -import Data.Maybe (Maybe(..)) +import Data.Maybe (maybe, Maybe(..)) import Data.Newtype (class Newtype, unwrap) +import Data.Set (Set) import Data.Show.Generic (genericShow) import Data.These (These(..)) import Data.Tuple.Nested ((/\), type (/\)) @@ -47,6 +53,7 @@ newtype TokenName = TokenName String derive instance eqTokenName :: Eq TokenName derive instance ordTokenName :: Ord TokenName derive instance genericTokenName :: Generic TokenName _ +derive instance newtypeTokenName :: Newtype TokenName _ instance showTokenName :: Show TokenName where show = genericShow @@ -232,3 +239,24 @@ valueOf (Value mp) cur tn = -- | Make a 'Value' containing only the given quantity of the given currency. singleton :: CurrencySymbol -> TokenName -> BigInt -> Value singleton c tn i = Value (Map.singleton c (Map.singleton tn i)) + +-- | The number of distinct currency symbols, i.e. the number of policy IDs. +numCurrencySymbols :: Value -> BigInt +numCurrencySymbols = fromInt <<< length <<< getValue + +numCurrencySymbols' :: Maybe Value -> BigInt +numCurrencySymbols' = maybe zero numCurrencySymbols + +-- Don't export this, we don't really care about the v in k,v. +allTokenNames' :: Value -> Map TokenName BigInt +allTokenNames' = unions <<< values <<< getValue + +allTokenNames :: Value -> Set TokenName +allTokenNames = keys <<< allTokenNames' + +-- | The number of distinct token names. +numTokenNames :: Value -> BigInt +numTokenNames = length <<< allTokenNames' + +numTokenNames' :: Maybe Value -> BigInt +numTokenNames' = maybe zero numTokenNames \ No newline at end of file