diff --git a/examples/txbuild/Main.elm b/examples/txbuild/Main.elm index c34785d..c6b60a4 100644 --- a/examples/txbuild/Main.elm +++ b/examples/txbuild/Main.elm @@ -18,7 +18,7 @@ main = example ex = case ex () of Err error -> - error + Debug.toString error Ok tx -> Cardano.prettyTx tx @@ -31,10 +31,11 @@ example ex = view : () -> Html () view _ = div [] - [ div [] [ text "Example transaction 1: send 1 ada from me to you" ] + [ div [] [ text "Example transaction 1: send 1 ada from me to you." ] , Html.pre [] [ text <| example Cardano.example1 ] - , div [] [ text "Example transaction 2: mint dog & burn 1 cat" ] + , div [] [ text "Example transaction 2: mint 1 dog & burn 1 cat." ] , Html.pre [] [ text <| example Cardano.example2 ] - , div [] [ text "Example transaction 3: spend 1 ada from a plutus script with 2 ada" ] + , div [] [ text "Example transaction 3: spend 1 ada from a plutus script with 2 ada." ] + , div [] [ text "Spent UTxO index is passed as argument in the redeemer." ] , Html.pre [] [ text <| example Cardano.example3 ] ] diff --git a/src/Cardano.elm b/src/Cardano.elm index 48d2deb..38814a4 100644 --- a/src/Cardano.elm +++ b/src/Cardano.elm @@ -1,7 +1,8 @@ module Cardano exposing ( TxIntent(..), SpendSource(..), InputsOutputs, ScriptWitness(..), PlutusScriptWitness, WitnessSource(..) , TxOtherInfo(..) - , finalize + , Fee(..) + , finalize, TxFinalizationError(..) , example1, example2, example3, prettyTx ) @@ -321,7 +322,8 @@ We can embed it directly in the transaction witness. @docs TxIntent, SpendSource, InputsOutputs, ScriptWitness, PlutusScriptWitness, WitnessSource @docs TxOtherInfo -@docs finalize +@docs Fee +@docs finalize, TxFinalizationError -} @@ -334,9 +336,10 @@ import Cardano.Data as Data exposing (Data) import Cardano.MultiAsset as MultiAsset exposing (AssetName, MultiAsset, PolicyId) import Cardano.Redeemer as Redeemer exposing (Redeemer, RedeemerTag) import Cardano.Script as Script exposing (NativeScript, PlutusScript, PlutusVersion(..), ScriptCbor) -import Cardano.Transaction exposing (Transaction, TransactionBody, WitnessSet) -import Cardano.Transaction.AuxiliaryData.Metadatum exposing (Metadatum) -import Cardano.Transaction.Builder exposing (requiredSigner) +import Cardano.Transaction as Transaction exposing (ScriptDataHash, Transaction, TransactionBody, VKeyWitness, WitnessSet) +import Cardano.Transaction.AuxiliaryData exposing (AuxiliaryData) +import Cardano.Transaction.AuxiliaryData.Metadatum as Metadatum exposing (Metadatum) +import Cardano.Transaction.Builder exposing (requiredSigner, totalCollateral) import Cardano.Utxo as Utxo exposing (DatumOption(..), Output, OutputReference) import Cardano.Value as Value exposing (Value) import Cbor.Encode as E @@ -344,6 +347,7 @@ import Dict exposing (Dict) import Dict.Any exposing (AnyDict) import Integer exposing (Integer) import Natural exposing (Natural) +import Set type Todo @@ -375,7 +379,7 @@ type TxIntent {-| -} type SpendSource = From Address Value - -- Eventually improve "From Address Value"" with variants like: + -- (Maybe) Eventually improve "From Address Value"" with variants like: -- FromAnywhere Value -- FromPaymentKey (Bytes CredentialHash) | FromWalletUtxo OutputReference @@ -398,6 +402,13 @@ type alias InputsOutputs = } +{-| Helper initialization for InputsOutputs. +-} +noInputsOutputs : InputsOutputs +noInputsOutputs = + { referenceInputs = [], spentInputs = [], createdOutputs = [] } + + {-| -} type ScriptWitness = NativeWitness (WitnessSource NativeScript) @@ -418,12 +429,53 @@ type WitnessSource a | WitnessReference OutputReference +{-| Extract the [OutputReference] from a witness source, +if passed by reference. Return [Nothing] if passed by value. +-} +extractWitnessRef : WitnessSource a -> Maybe OutputReference +extractWitnessRef witnessSource = + case witnessSource of + WitnessValue _ -> + Nothing + + WitnessReference ref -> + Just ref + + {-| -} type TxOtherInfo = TxReferenceInput OutputReference | TxMetadata { tag : Natural, metadata : Metadatum } | TxTimeValidityRange { start : Int, end : Natural } - | TxManualFee { lovelace : Natural } + + +{-| -} +type Fee + = ManualFee (List { paymentSource : Address, exactFeeAmount : Natural }) + | AutoFee { paymentSource : Address } + + +{-| Initialize fee estimation by setting the fee field to ₳0.5 +This is represented as 500K lovelace, which is encoded as a 32bit uint. +32bit uint can represent a range from ₳0.065 to ₳4200 so it most likely won’t change. +-} +defaultAutoFee : Natural +defaultAutoFee = + Natural.fromSafeInt 500000 + + +{-| Errors that may happen during Tx finalization. +-} +type TxFinalizationError + = UnbalancedIntents String + | InsufficientManualFee { declared : Natural, computed : Natural } + | NotEnoughMinAda String + | ReferenceOutputsMissingFromLocalState (List OutputReference) + | FailedToPerformCoinSelection CoinSelection.Error + | CollateralSelectionError CoinSelection.Error + | DuplicatedMetadataTags Int + | IncorrectTimeValidityRange String + | FailurePleaseReportToElmCardano String {-| Finalize a transaction before signing and sending it. @@ -440,147 +492,154 @@ finalize : { localStateUtxos : Utxo.RefDict Output , coinSelectionAlgo : CoinSelection.Algorithm } + -> Fee -> List TxOtherInfo -> List TxIntent - -> Result String Transaction -finalize { localStateUtxos, coinSelectionAlgo } txOtherInfo txIntents = - -- TODO: Check that all spent referenced inputs are present in the local state - let - -- Initialize InputsOutputs - -- TODO: better initalization? - inputsOutputs = - { referenceInputs = [] - , spentInputs = [] - , createdOutputs = [] - } - - -- TODO: Deduplicate eventual duplicate witnesses (both value and reference) after processedIntents - processedIntents = - processIntents localStateUtxos txIntents - - totalInput = - Dict.Any.foldl (\_ -> Value.add) - processedIntents.preSelected.sum - processedIntents.freeInputs - - preCreatedOutputs = - processedIntents.preCreated inputsOutputs - - totalOutput = - Dict.Any.foldl (\_ -> Value.add) - preCreatedOutputs.sum - processedIntents.freeOutputs - in - if totalInput == totalOutput then - -- check that pre-created outputs have correct min ada - -- TODO: change this step to use processed intents directly - validMinAdaPerOutput inputsOutputs txIntents - -- UTxO selection - |> Result.andThen (\_ -> computeCoinSelection localStateUtxos processedIntents coinSelectionAlgo) - --> Result String (Address.Dict Selection) - -- Accumulate all selected UTxOs and newly created outputs - |> Result.map (accumPerAddressSelection processedIntents.freeOutputs) - --> Result String { selectedInputs : Utxo.RefDict Ouptut, createdOutputs : List Output } - -- Aggregate with pre-selected inputs and pre-created outputs - |> Result.map (\selection -> updateInputsOutputs processedIntents selection inputsOutputs) - --> Result String InputsOutputs - |> Result.map (buildTx processedIntents) - -- TODO: without estimating cost of plutus script exec, do few loops of: - -- - estimate Tx fees - -- - adjust coin selection - -- - adjust redeemers - -- TODO: evaluate plutus script cost, and do a final round of above - - else - let - _ = - Debug.log "totalInput" totalInput - - _ = - Debug.log "totalOutput" totalOutput - in - Err "Tx is not balanced.\n" - - -validMinAdaPerOutput : InputsOutputs -> List TxIntent -> Result String () -validMinAdaPerOutput inputsOutputs txIntents = - -- TODO: change this to be checked on processed intents - case txIntents of - [] -> - Ok () - - first :: others -> - case first of - SendToOutput f -> + -> Result TxFinalizationError Transaction +finalize { localStateUtxos, coinSelectionAlgo } fee txOtherInfo txIntents = + case ( processIntents localStateUtxos txIntents, processOtherInfo txOtherInfo ) of + ( Err err, _ ) -> + Err err + + ( _, Err err ) -> + Err err + + ( Ok processedIntents, Ok processedOtherInfo ) -> + let + buildTxRound : InputsOutputs -> Fee -> Result TxFinalizationError Transaction + buildTxRound roundInputsOutputs roundFees = let - output = - f inputsOutputs - - outputMinAda = - Utxo.minAda output + ( feeAmount, feeAddresses ) = + case roundFees of + ManualFee perAddressFee -> + ( List.foldl (\{ exactFeeAmount } -> Natural.add exactFeeAmount) Natural.zero perAddressFee + , List.map .paymentSource perAddressFee + ) + + AutoFee { paymentSource } -> + ( defaultAutoFee, [ paymentSource ] ) + + ( collateralAmount, collateralSources ) = + if List.isEmpty processedIntents.plutusScriptSources then + ( Natural.zero, Address.emptyDict ) + + else + -- collateral = 1.5 * fee + -- It’s an euclidean division, so if there is a non-zero rest, + -- we add 1 to make sure we aren’t short 1 lovelace. + ( feeAmount + |> Natural.mul (Natural.fromSafeInt 15) + |> Natural.divModBy (Natural.fromSafeInt 10) + |> Maybe.withDefault ( Natural.zero, Natural.zero ) + |> (\( q, r ) -> Natural.add q <| Natural.min r Natural.one) + -- Identify automatically collateral sources + -- from fee addresses, free inputs addresses or spent inputs addresses. + , [ feeAddresses + , Dict.Any.keys processedIntents.freeInputs + , Dict.Any.keys processedIntents.preSelected.inputs + |> List.filterMap (\addr -> Dict.Any.get addr localStateUtxos |> Maybe.map .address) + ] + |> List.concat + |> List.filter Address.isShelleyWallet + -- make the list unique + |> List.map (\addr -> ( addr, () )) + |> Address.dictFromList + ) in - if Utxo.lovelace output |> Natural.isGreaterThanOrEqual outputMinAda then - validMinAdaPerOutput inputsOutputs others - - else - Err ("Output has less ada than its required min ada (" ++ Natural.toString outputMinAda ++ "):\n" ++ Debug.toString output) - - _ -> - validMinAdaPerOutput inputsOutputs others + -- UTxO selection + Result.map2 + (\coinSelection collateralSelection -> + --> coinSelection : Address.Dict (Selection, List Output) + -- Accumulate all selected UTxOs and newly created outputs + accumPerAddressSelection coinSelection + --> { selectedInputs : Utxo.RefDict Ouptut, createdOutputs : List Output } + -- Aggregate with pre-selected inputs and pre-created outputs + |> (\selection -> updateInputsOutputs processedIntents selection roundInputsOutputs) + --> InputsOutputs + |> buildTx localStateUtxos feeAmount collateralSelection processedIntents processedOtherInfo + ) + (computeCoinSelection localStateUtxos roundFees processedIntents coinSelectionAlgo) + (computeCollateralSelection localStateUtxos collateralSources collateralAmount) + extractInputsOutputs tx = + { referenceInputs = tx.body.referenceInputs + , spentInputs = tx.body.inputs + , createdOutputs = tx.body.outputs + } -type alias ProcessedIntents = + adjustFees tx = + case fee of + ManualFee _ -> + fee + + AutoFee { paymentSource } -> + Transaction.computeFees tx + |> Debug.log "estimatedFee" + |> (\computedFee -> ManualFee [ { paymentSource = paymentSource, exactFeeAmount = computedFee } ]) + in + -- Without estimating cost of plutus script exec, do few loops of: + -- - estimate Tx fees + -- - adjust coin selection + -- - adjust redeemers + buildTxRound noInputsOutputs fee + --> Result String Transaction + |> Result.andThen (\tx -> buildTxRound (extractInputsOutputs tx) (adjustFees tx)) + -- TODO: Evaluate plutus script cost, and do a final round of above + -- Finally, check if final fees are correct + |> Result.andThen (checkInsufficientFee fee) + |> identity + + +type alias PreProcessedIntents = { freeInputs : Address.Dict Value , freeOutputs : Address.Dict Value - , preSelected : { sum : Value, inputs : Utxo.RefDict (Maybe (InputsOutputs -> Data)) } + , preSelected : List { input : OutputReference, redeemer : Maybe (InputsOutputs -> Data) } , preCreated : InputsOutputs -> { sum : Value, outputs : List Output } , nativeScriptSources : List (WitnessSource NativeScript) , plutusScriptSources : List (WitnessSource PlutusScript) , datumSources : List (WitnessSource Data) - , requiredSigners : List (Bytes CredentialHash) - , totalMinted : MultiAsset Integer - , mintRedeemers : BytesMap PolicyId (Maybe (InputsOutputs -> Data)) - , withdrawals : Address.StakeDict { amount : Natural, redeemer : Maybe (InputsOutputs -> Data) } + , requiredSigners : List (List (Bytes CredentialHash)) + , mints : List { policyId : Bytes CredentialHash, assets : BytesMap AssetName Integer, redeemer : Maybe (InputsOutputs -> Data) } + , withdrawals : List { stakeAddress : StakeAddress, amount : Natural, redeemer : Maybe (InputsOutputs -> Data) } } -noIntent : ProcessedIntents +noIntent : PreProcessedIntents noIntent = { freeInputs = Address.emptyDict , freeOutputs = Address.emptyDict - , preSelected = { sum = Value.zero, inputs = Utxo.emptyRefDict } + , preSelected = [] , preCreated = \_ -> { sum = Value.zero, outputs = [] } , nativeScriptSources = [] , plutusScriptSources = [] , datumSources = [] , requiredSigners = [] - , totalMinted = MultiAsset.empty - , mintRedeemers = Map.empty - , withdrawals = Address.emptyStakeDict + , mints = [] + , withdrawals = [] } -processIntents : Utxo.RefDict Output -> List TxIntent -> ProcessedIntents -processIntents localStateUtxos txIntents = - let - -- Retrieve the ada and tokens amount at a given output reference - getValueFromRef : OutputReference -> Value - getValueFromRef ref = - Dict.Any.get ref localStateUtxos - |> Maybe.map .amount - |> Maybe.withDefault Value.zero +{-| Initial processing step in order to categorize all intents. + +This pre-processing step does not need the local utxo state. +It only aggregates all intents into relevant fields +to make following processing steps easier. +-} +preProcessIntents : List TxIntent -> PreProcessedIntents +preProcessIntents txIntents = + let freeValueAdd : Address -> Value -> Address.Dict Value -> Address.Dict Value freeValueAdd addr v freeValue = Dict.Any.update addr (Just << Value.add v << Maybe.withDefault Value.zero) freeValue - -- Step function that processes each TxIntent - stepIntent : TxIntent -> ProcessedIntents -> ProcessedIntents - stepIntent txIntent processedIntents = + -- Step function that pre-processes each TxIntent + stepIntent : TxIntent -> PreProcessedIntents -> PreProcessedIntents + stepIntent txIntent preProcessedIntents = case txIntent of SendTo addr v -> - { processedIntents - | freeOutputs = freeValueAdd addr v processedIntents.freeOutputs + { preProcessedIntents + | freeOutputs = freeValueAdd addr v preProcessedIntents.freeOutputs } SendToOutput f -> @@ -588,7 +647,7 @@ processIntents localStateUtxos txIntents = newPreCreated inputsOutputs = let { sum, outputs } = - processedIntents.preCreated inputsOutputs + preProcessedIntents.preCreated inputsOutputs newOutput = f inputsOutputs @@ -597,20 +656,20 @@ processIntents localStateUtxos txIntents = , outputs = newOutput :: outputs } in - { processedIntents | preCreated = newPreCreated } + { preProcessedIntents | preCreated = newPreCreated } Spend (From addr v) -> - { processedIntents - | freeInputs = freeValueAdd addr v processedIntents.freeInputs + { preProcessedIntents + | freeInputs = freeValueAdd addr v preProcessedIntents.freeInputs } Spend (FromWalletUtxo ref) -> - { processedIntents | preSelected = addPreSelectedInput ( ref, Nothing ) (getValueFromRef ref) processedIntents.preSelected } + { preProcessedIntents | preSelected = { input = ref, redeemer = Nothing } :: preProcessedIntents.preSelected } Spend (FromNativeScript { spentInput, nativeScriptWitness }) -> - { processedIntents - | preSelected = addPreSelectedInput ( spentInput, Nothing ) (getValueFromRef spentInput) processedIntents.preSelected - , nativeScriptSources = nativeScriptWitness :: processedIntents.nativeScriptSources + { preProcessedIntents + | preSelected = { input = spentInput, redeemer = Nothing } :: preProcessedIntents.preSelected + , nativeScriptSources = nativeScriptWitness :: preProcessedIntents.nativeScriptSources } Spend (FromPlutusScript { spentInput, datumWitness, plutusScriptWitness }) -> @@ -618,119 +677,404 @@ processIntents localStateUtxos txIntents = newDatumSources = case datumWitness of Nothing -> - processedIntents.datumSources + preProcessedIntents.datumSources Just datumSource -> - datumSource :: processedIntents.datumSources + datumSource :: preProcessedIntents.datumSources in - { processedIntents - | preSelected = addPreSelectedInput ( spentInput, Just plutusScriptWitness.redeemerData ) (getValueFromRef spentInput) processedIntents.preSelected + { preProcessedIntents + | preSelected = { input = spentInput, redeemer = Just plutusScriptWitness.redeemerData } :: preProcessedIntents.preSelected , datumSources = newDatumSources - , requiredSigners = plutusScriptWitness.requiredSigners ++ processedIntents.requiredSigners - , plutusScriptSources = plutusScriptWitness.script :: processedIntents.plutusScriptSources + , requiredSigners = plutusScriptWitness.requiredSigners :: preProcessedIntents.requiredSigners + , plutusScriptSources = plutusScriptWitness.script :: preProcessedIntents.plutusScriptSources } - -- TODO: check that policyId wasn’t already present in totalMinted MintBurn { policyId, assets, scriptWitness } -> - let - { minted, burned } = - MultiAsset.balance assets - - newPreCreated inputsOutputs = - let - { sum, outputs } = - processedIntents.preCreated inputsOutputs - in - { sum = Value.addTokens (Map.singleton policyId burned) sum - , outputs = outputs + case scriptWitness of + NativeWitness script -> + { preProcessedIntents + | nativeScriptSources = script :: preProcessedIntents.nativeScriptSources + , mints = { policyId = policyId, assets = assets, redeemer = Nothing } :: preProcessedIntents.mints } - addWitnessAndRedeemer : ProcessedIntents -> ProcessedIntents - addWitnessAndRedeemer before = - case scriptWitness of - NativeWitness script -> - { before - | nativeScriptSources = script :: before.nativeScriptSources - , mintRedeemers = Map.insert policyId Nothing before.mintRedeemers - } - - PlutusWitness { script, redeemerData, requiredSigners } -> - { before - | plutusScriptSources = script :: before.plutusScriptSources - , requiredSigners = requiredSigners ++ before.requiredSigners - , mintRedeemers = Map.insert policyId (Just redeemerData) before.mintRedeemers - } - in - addWitnessAndRedeemer - { processedIntents - | preSelected = - { sum = Value.addTokens (Map.singleton policyId minted) processedIntents.preSelected.sum - , inputs = processedIntents.preSelected.inputs - } - , preCreated = newPreCreated - , totalMinted = MultiAsset.mintAdd processedIntents.totalMinted (Map.singleton policyId assets) - } + PlutusWitness { script, redeemerData, requiredSigners } -> + { preProcessedIntents + | plutusScriptSources = script :: preProcessedIntents.plutusScriptSources + , requiredSigners = requiredSigners :: preProcessedIntents.requiredSigners + , mints = { policyId = policyId, assets = assets, redeemer = Just redeemerData } :: preProcessedIntents.mints + } WithdrawRewards { stakeCredential, amount, scriptWitness } -> - let - addWitnessAndRedeemer : ProcessedIntents -> ProcessedIntents - addWitnessAndRedeemer before = - case scriptWitness of - Nothing -> - { before - | withdrawals = Dict.Any.insert stakeCredential { amount = amount, redeemer = Nothing } processedIntents.withdrawals - } - - Just (NativeWitness script) -> - { before - | withdrawals = Dict.Any.insert stakeCredential { amount = amount, redeemer = Nothing } processedIntents.withdrawals - , nativeScriptSources = script :: before.nativeScriptSources - } - - Just (PlutusWitness { script, redeemerData, requiredSigners }) -> - { before - | withdrawals = Dict.Any.insert stakeCredential { amount = amount, redeemer = Just redeemerData } processedIntents.withdrawals - , plutusScriptSources = script :: before.plutusScriptSources - , requiredSigners = requiredSigners ++ before.requiredSigners - } - in - addWitnessAndRedeemer - { processedIntents - | preSelected = - { sum = Value.add (Value.onlyLovelace amount) processedIntents.preSelected.sum - , inputs = processedIntents.preSelected.inputs - } - } + case scriptWitness of + Nothing -> + { preProcessedIntents + | withdrawals = { stakeAddress = stakeCredential, amount = amount, redeemer = Nothing } :: preProcessedIntents.withdrawals + } + + Just (NativeWitness script) -> + { preProcessedIntents + | withdrawals = { stakeAddress = stakeCredential, amount = amount, redeemer = Nothing } :: preProcessedIntents.withdrawals + , nativeScriptSources = script :: preProcessedIntents.nativeScriptSources + } + + Just (PlutusWitness { script, redeemerData, requiredSigners }) -> + { preProcessedIntents + | withdrawals = { stakeAddress = stakeCredential, amount = amount, redeemer = Just redeemerData } :: preProcessedIntents.withdrawals + , plutusScriptSources = script :: preProcessedIntents.plutusScriptSources + , requiredSigners = requiredSigners :: preProcessedIntents.requiredSigners + } -- TODO: Handle certificates _ -> - processedIntents + Debug.todo "certificates" in -- Use fold right so that the outputs list is in the correct order List.foldr stepIntent noIntent txIntents +type alias ProcessedIntents = + { freeInputs : Address.Dict Value + , freeOutputs : Address.Dict Value + , preSelected : { sum : Value, inputs : Utxo.RefDict (Maybe (InputsOutputs -> Data)) } + , preCreated : InputsOutputs -> { sum : Value, outputs : List Output } + , nativeScriptSources : List (WitnessSource NativeScript) + , plutusScriptSources : List (WitnessSource PlutusScript) + , datumSources : List (WitnessSource Data) + , requiredSigners : List (Bytes CredentialHash) + , totalMinted : MultiAsset Integer + , mintRedeemers : BytesMap PolicyId (Maybe (InputsOutputs -> Data)) + , withdrawals : Address.StakeDict { amount : Natural, redeemer : Maybe (InputsOutputs -> Data) } + } + + +type TxIntentError + = TxIntentError String + + +{-| Process already pre-processed intents and validate them all. +-} +processIntents : Utxo.RefDict Output -> List TxIntent -> Result TxFinalizationError ProcessedIntents +processIntents localStateUtxos txIntents = + let + preProcessedIntents = + preProcessIntents txIntents + + -- Accumulate all output references from inputs and witnesses. + allOutputReferencesInIntents : Utxo.RefDict () + allOutputReferencesInIntents = + List.concat + [ List.map .input preProcessedIntents.preSelected + , List.filterMap extractWitnessRef preProcessedIntents.nativeScriptSources + , List.filterMap extractWitnessRef preProcessedIntents.plutusScriptSources + , List.filterMap extractWitnessRef preProcessedIntents.datumSources + ] + |> List.map (\ref -> ( ref, () )) + |> Utxo.refDictFromList + + -- Check that all referenced inputs are present in the local state + absentOutputReferencesInLocalState : Utxo.RefDict () + absentOutputReferencesInLocalState = + Dict.Any.diff allOutputReferencesInIntents + (Dict.Any.map (\_ _ -> ()) localStateUtxos) + + totalMintedAndBurned : MultiAsset Integer + totalMintedAndBurned = + List.map (\m -> Map.singleton m.policyId m.assets) preProcessedIntents.mints + |> List.foldl MultiAsset.mintAdd MultiAsset.empty + |> MultiAsset.normalize Integer.isZero + + -- Extract total minted value and total burned value + splitMintsBurns = + List.map (\m -> ( m.policyId, MultiAsset.balance m.assets )) preProcessedIntents.mints + + totalMintedValue = + List.foldl (\( p, { minted } ) -> Value.addTokens (Map.singleton p minted)) Value.zero splitMintsBurns + + totalBurnedValue = + List.foldl (\( p, { burned } ) -> Value.addTokens (Map.singleton p burned)) Value.zero splitMintsBurns + + -- Extract total ada amount withdrawn + totalWithdrawalAmount = + List.foldl (\w acc -> Natural.add w.amount acc) Natural.zero preProcessedIntents.withdrawals + + -- Retrieve the ada and tokens amount at a given output reference + getValueFromRef : OutputReference -> Value + getValueFromRef ref = + Dict.Any.get ref localStateUtxos + |> Maybe.map .amount + |> Maybe.withDefault Value.zero + + -- Extract value thanks to input refs + -- Also add minted tokens and withdrawals to preSelected + preSelected = + preProcessedIntents.preSelected + |> List.foldl (\s -> addPreSelectedInput s.input (getValueFromRef s.input) s.redeemer) + { sum = Value.add totalMintedValue (Value.onlyLovelace totalWithdrawalAmount) + , inputs = Utxo.emptyRefDict + } + + -- Add burned tokens to preCreated + preCreated = + \inputsOutputs -> + let + { sum, outputs } = + preProcessedIntents.preCreated inputsOutputs + in + { sum = Value.add sum totalBurnedValue, outputs = outputs } + + preCreatedOutputs = + preCreated noInputsOutputs + + -- Compute total inputs and outputs to check the Tx balance + totalInput = + Dict.Any.foldl (\_ -> Value.add) preSelected.sum preProcessedIntents.freeInputs + + totalOutput = + Dict.Any.foldl (\_ -> Value.add) preCreatedOutputs.sum preProcessedIntents.freeOutputs + in + if not <| Dict.Any.isEmpty absentOutputReferencesInLocalState then + Err <| ReferenceOutputsMissingFromLocalState (Dict.Any.keys absentOutputReferencesInLocalState) + + else if totalInput /= totalOutput then + let + _ = + Debug.log "totalInput" totalInput + + _ = + Debug.log "totalOutput" totalOutput + in + Err <| UnbalancedIntents "Tx is not balanced.\n" + + else + validMinAdaPerOutput preCreatedOutputs.outputs + |> Result.mapError NotEnoughMinAda + |> Result.map + (\_ -> + let + -- Dedup required signers + requiredSigners = + List.concat preProcessedIntents.requiredSigners + |> List.map (\signer -> ( signer, () )) + |> Map.fromList + |> Map.keys + in + { freeInputs = preProcessedIntents.freeInputs + , freeOutputs = preProcessedIntents.freeOutputs + , preSelected = preSelected + , preCreated = preCreated + , nativeScriptSources = dedupWitnessSources Script.encodeNativeScript preProcessedIntents.nativeScriptSources + , plutusScriptSources = dedupWitnessSources Script.encodePlutusScript preProcessedIntents.plutusScriptSources + , datumSources = dedupWitnessSources Data.toCbor preProcessedIntents.datumSources + , requiredSigners = requiredSigners + , totalMinted = totalMintedAndBurned + , mintRedeemers = + List.map (\m -> ( m.policyId, m.redeemer )) preProcessedIntents.mints + |> Map.fromList + , withdrawals = + List.map (\w -> ( w.stakeAddress, { amount = w.amount, redeemer = w.redeemer } )) preProcessedIntents.withdrawals + |> Address.stakeDictFromList + } + ) + + +{-| Helper function +-} +dedupWitnessSources : (a -> E.Encoder) -> List (WitnessSource a) -> List (WitnessSource a) +dedupWitnessSources toCbor sources = + let + -- Split values and references in two lists + ( values, refs ) = + List.foldl + (\source ( vs, rs ) -> + case source of + WitnessValue v -> + ( v :: vs, rs ) + + WitnessReference ref -> + ( vs, ref :: rs ) + ) + ( [], [] ) + sources + + -- Create the comparable function from the encoder + toComparable v = + E.encode (toCbor v) |> Bytes.fromBytes |> Bytes.toString + + -- Dedup values + dedupedValues = + List.map (\v -> ( v, () )) values + |> Dict.Any.fromList toComparable + |> Dict.Any.keys + + dedupedRefs = + List.map (\ref -> ( ref, () )) refs + |> Utxo.refDictFromList + |> Dict.Any.keys + in + List.map WitnessValue dedupedValues ++ List.map WitnessReference dedupedRefs + + {-| Helper function -} addPreSelectedInput : - ( OutputReference, Maybe (InputsOutputs -> Data) ) + OutputReference -> Value + -> Maybe (InputsOutputs -> Data) -> { sum : Value, inputs : Utxo.RefDict (Maybe (InputsOutputs -> Data)) } -> { sum : Value, inputs : Utxo.RefDict (Maybe (InputsOutputs -> Data)) } -addPreSelectedInput ( ref, maybeDatum ) value { sum, inputs } = +addPreSelectedInput ref value maybeRedeemer { sum, inputs } = { sum = Value.add value sum - , inputs = Dict.Any.insert ref maybeDatum inputs + , inputs = Dict.Any.insert ref maybeRedeemer inputs } +validMinAdaPerOutput : List Output -> Result String () +validMinAdaPerOutput outputs = + case outputs of + [] -> + Ok () + + output :: rest -> + case Utxo.checkMinAda output of + Ok _ -> + validMinAdaPerOutput rest + + Err err -> + Err err + + +type alias ProcessedOtherInfo = + { referenceInputs : List OutputReference + , metadata : List { tag : Natural, metadata : Metadatum } + , timeValidityRange : Maybe { start : Int, end : Natural } + } + + +noInfo : ProcessedOtherInfo +noInfo = + { referenceInputs = [] + , metadata = [] + , timeValidityRange = Nothing + } + + +type TxOtherInfoError + = TxOtherInfoError String + + +processOtherInfo : List TxOtherInfo -> Result TxFinalizationError ProcessedOtherInfo +processOtherInfo otherInfo = + let + processedOtherInfo = + List.foldl + (\info acc -> + case info of + TxReferenceInput ref -> + { acc | referenceInputs = ref :: acc.referenceInputs } + + TxMetadata m -> + { acc | metadata = m :: acc.metadata } + + TxTimeValidityRange ({ start, end } as newVR) -> + { acc + | timeValidityRange = + case acc.timeValidityRange of + Nothing -> + Just newVR + + Just vr -> + Just { start = max start vr.start, end = Natural.min end vr.end } + } + ) + noInfo + otherInfo + + -- Check if there are duplicate metadata tags. + -- (use Int instead of Natural for this purpose) + metadataTags = + List.map (.tag >> Natural.toInt) processedOtherInfo.metadata + + hasDuplicatedMetadataTags = + List.length metadataTags /= Set.size (Set.fromList metadataTags) + + -- Check that the time range intersection is still valid + validTimeRange = + case processedOtherInfo.timeValidityRange of + Nothing -> + True + + Just range -> + Natural.fromSafeInt range.start |> Natural.isLessThan range.end + in + if hasDuplicatedMetadataTags then + let + findDuplicate current tags = + case tags of + [] -> + Nothing + + t :: biggerTags -> + if t == current then + Just t + + else + findDuplicate t biggerTags + + dupTag = + findDuplicate -1 (List.sort metadataTags) + |> Maybe.withDefault -1 + in + Err <| DuplicatedMetadataTags dupTag + + else if not validTimeRange then + Err <| IncorrectTimeValidityRange <| "Invalid time range (or intersection of multiple time ranges). The time range end must be > than the start." ++ Debug.toString processedOtherInfo.timeValidityRange + + else + Ok processedOtherInfo + + +{-| Perform collateral selection. + +Only UTxOs at the provided whitelist of addresses are viable. +Only UTxOs containing only Ada, without other CNT or datums are viable. + +-} +computeCollateralSelection : + Utxo.RefDict Output + -> Address.Dict () + -> Natural + -> Result TxFinalizationError CoinSelection.Selection +computeCollateralSelection localStateUtxos collateralSources collateralAmount = + CoinSelection.largestFirst 10 + { alreadySelectedUtxos = [] + , targetAmount = Value.onlyLovelace collateralAmount + , availableUtxos = + Dict.Any.toList localStateUtxos + |> List.filter + (\( _, output ) -> + Utxo.isAdaOnly output + && Dict.Any.member output.address collateralSources + ) + } + |> Result.mapError CollateralSelectionError + + {-| Perform coin selection for the required input per address. + +For each address, create an [Output] with the change. +The output must satisfy minAda. + +TODO: If there is more than 5 ada free in the change (after minAda), +also create a pure-ada output so that we don’t deplete all outputs viable for collateral. + -} computeCoinSelection : Utxo.RefDict Output + -> Fee -> ProcessedIntents -> CoinSelection.Algorithm - -> Result String (Address.Dict CoinSelection.Selection) -computeCoinSelection localStateUtxos processedIntents coinSelectionAlgo = + -> Result TxFinalizationError (Address.Dict ( CoinSelection.Selection, List Output )) +computeCoinSelection localStateUtxos fee processedIntents coinSelectionAlgo = let dummyOutput = { address = Byron <| Bytes.fromStringUnchecked "" @@ -744,93 +1088,196 @@ computeCoinSelection localStateUtxos processedIntents coinSelectionAlgo = -- Using dummyOutput to have the same type as localStateUtxos Dict.Any.map (\_ _ -> dummyOutput) processedIntents.preSelected.inputs - -- Precompute selectable inputs accross all addresses + -- Precompute selectable inputs per addresses + availableInputs : Address.Dict (List ( OutputReference, Output )) availableInputs = Dict.Any.diff localStateUtxos notAvailableInputs + --> Utxo.RefDict Output + |> Dict.Any.foldl + (\ref output -> + -- append the output to the list of outputs for the same address + Dict.Any.update output.address + (Just << (::) ( ref, output ) << Maybe.withDefault []) + ) + Address.emptyDict -- TODO: adjust at least with the number of different tokens in target Amount maxInputCount = 10 + + -- Add the fee to free inputs + addFee : Address -> Natural -> Address.Dict Value -> Address.Dict Value + addFee addr amount dict = + Dict.Any.update addr (Just << Value.add (Value.onlyLovelace amount) << Maybe.withDefault Value.zero) dict + + freeInputsWithFee : Address.Dict Value + freeInputsWithFee = + case fee of + ManualFee perAddressFee -> + List.foldl + (\{ paymentSource, exactFeeAmount } -> addFee paymentSource exactFeeAmount) + processedIntents.freeInputs + perAddressFee + + AutoFee { paymentSource } -> + addFee paymentSource defaultAutoFee processedIntents.freeInputs + + -- These are the free outputs that are unrelated to any address with fees or free input. + -- It’s address dict keys are all different from those of freeInputsWithFee + independentFreeOutputValues : Address.Dict Value + independentFreeOutputValues = + Dict.Any.diff processedIntents.freeOutputs freeInputsWithFee + + -- These will require they have enough minAda to make their own independent outputs. + validIndependentFreeOutputs : Result TxFinalizationError (Address.Dict Output) + validIndependentFreeOutputs = + independentFreeOutputValues + |> Dict.Any.map (\addr output -> Utxo.checkMinAda <| Utxo.simpleOutput addr output) + |> resultDictJoin + |> Result.mapError NotEnoughMinAda + + -- These are the free outputs that are related to any address with fees or free input. + -- It’s address dict keys are a subset of those of freeInputsWithFee + relatedFreeOutputValues : Address.Dict Value + relatedFreeOutputValues = + Dict.Any.diff processedIntents.freeOutputs independentFreeOutputValues + + -- Merge the two dicts : + -- - freeInputsWithFee (that will become the coin selection target value) + -- - relatedFreeOutputValues (that will be added to the coin selection change) + targetValuesAndOutputs : Address.Dict { targetInputValue : Value, freeOutput : Value } + targetValuesAndOutputs = + let + whenInput addr v = + Dict.Any.insert addr { targetInputValue = v, freeOutput = Value.zero } + + whenOutput addr v = + Dict.Any.insert addr { targetInputValue = Value.zero, freeOutput = v } + + whenBoth addr input output = + Dict.Any.insert addr { targetInputValue = input, freeOutput = output } + in + Dict.Any.merge whenInput + whenBoth + whenOutput + freeInputsWithFee + relatedFreeOutputValues + Address.emptyDict + + -- Perform coin selection and output creation with the change + -- for all address where there are target values (inputs and fees) + coinSelectionAndChangeOutputs : Result TxFinalizationError (Address.Dict ( CoinSelection.Selection, List Output )) + coinSelectionAndChangeOutputs = + targetValuesAndOutputs + -- Apply the selection algo for each address with input requirements + |> Dict.Any.map + (\addr { targetInputValue, freeOutput } -> + let + hasFreeOutput = + freeOutput /= Value.zero + + availableUtxosDict = + Maybe.withDefault [] (Dict.Any.get addr availableInputs) + |> Utxo.refDictFromList + + context targetAmount alreadySelected = + { targetAmount = targetAmount + , alreadySelectedUtxos = alreadySelected + , availableUtxos = + Dict.Any.diff availableUtxosDict (Utxo.refDictFromList alreadySelected) + |> Dict.Any.toList + } + + -- Create the output(s) with the change + free output, if there is enough minAda + makeChangeOutput : CoinSelection.Selection -> Result CoinSelection.Error ( CoinSelection.Selection, List Output ) + makeChangeOutput selection = + case ( selection.change, hasFreeOutput ) of + ( Nothing, False ) -> + Ok ( selection, [] ) + + _ -> + let + change = + Value.add (Maybe.withDefault Value.zero selection.change) freeOutput + + changeOutput = + { address = addr + , amount = change + , datumOption = Nothing + , referenceScript = Nothing + } + + minAda = + Utxo.minAda changeOutput + in + if change.lovelace |> Natural.isGreaterThanOrEqual minAda then + -- TODO: later, if there is more than 5 free ada, make an additional ada-only output + Ok ( selection, [ changeOutput ] ) + + else + Err <| + CoinSelection.UTxOBalanceInsufficient + { selectedUtxos = selection.selectedUtxos + , missingValue = Value.onlyLovelace <| Natural.sub minAda change.lovelace + } + + coinSelectIter targetValue alreadySelected = + coinSelectionAlgo maxInputCount (context targetValue alreadySelected) + |> Result.andThen makeChangeOutput + in + -- Try coin selection up to 2 times if the only missing value is Ada. + -- Why 2 times? because the first time, it might be missing minAda for the change output. + case coinSelectIter targetInputValue [] of + (Err (CoinSelection.UTxOBalanceInsufficient err1)) as err -> + if MultiAsset.isEmpty err1.missingValue.assets then + coinSelectIter (Value.add targetInputValue err1.missingValue) err1.selectedUtxos + + else + err + + selectionResult -> + selectionResult + ) + -- Join the Dict (Result _ _) into Result _ Dict + |> resultDictJoin + |> Result.mapError FailedToPerformCoinSelection in - processedIntents.freeInputs - -- Apply the selection algo for each address with input requirements - |> Dict.Any.map - (\addr freeValue -> - coinSelectionAlgo maxInputCount - { alreadySelectedUtxos = [] - , targetAmount = freeValue - - -- Only keep inputs from this address - , availableUtxos = - availableInputs - |> Dict.Any.filter (\_ output -> output.address == addr) - |> Dict.Any.toList - } - ) - -- Join the Dict (Result _ _) into Result _ Dict - |> Dict.Any.foldl - (\addr selectRes accumRes -> - Result.map2 (Dict.Any.insert addr) selectRes accumRes - ) - (Ok Address.emptyDict) - -- |> Result.map (Debug.log "coin selection") - |> Result.mapError Debug.toString + Result.map2 + (Dict.Any.foldl (\addr output -> Dict.Any.insert addr ( { selectedUtxos = [], change = Nothing }, [ output ] ))) + coinSelectionAndChangeOutputs + validIndependentFreeOutputs + + +{-| Helper function to join Dict Result into Result Dict. +-} +resultDictJoin : AnyDict comparable key (Result err value) -> Result err (AnyDict comparable key value) +resultDictJoin dict = + Dict.Any.foldl (\key -> Result.map2 (Dict.Any.insert key)) (Ok <| Dict.Any.removeAll dict) dict {-| Helper function to accumulate all selected UTxOs and newly created outputs. -} accumPerAddressSelection : - Address.Dict Value - -> Address.Dict CoinSelection.Selection + Address.Dict ( CoinSelection.Selection, List Output ) -> { selectedInputs : Utxo.RefDict Output, createdOutputs : List Output } -accumPerAddressSelection freeOutput allSelections = - let - -- Reshape freeOutput as a selection to be able to merge with the selection change - freeOutputAsSelection = - Dict.Any.map (\_ v -> { selectedUtxos = [], change = Just v }) freeOutput - - mergeHelper sel freeSel = - case freeSel.change of - Nothing -> - sel - - Just v -> - { selectedUtxos = sel.selectedUtxos, change = Just <| Value.add v (Maybe.withDefault Value.zero sel.change) } - - -- Merge the freeOutput value with the change from coin selection - mergedSelection = - Dict.Any.merge - Dict.Any.insert - (\addr sel freeSel acc -> - Dict.Any.insert addr (mergeHelper sel freeSel) acc - ) - Dict.Any.insert - allSelections - freeOutputAsSelection - Address.emptyDict - in +accumPerAddressSelection allSelections = Dict.Any.foldl - (\addr { selectedUtxos, change } acc -> + (\addr ( { selectedUtxos }, createdOutputs ) acc -> { selectedInputs = List.foldl (\( ref, output ) -> Dict.Any.insert ref output) acc.selectedInputs selectedUtxos - , createdOutputs = - case change of - Nothing -> - acc.createdOutputs - - Just value -> - { address = addr, amount = value, datumOption = Nothing, referenceScript = Nothing } :: acc.createdOutputs + , createdOutputs = createdOutputs ++ acc.createdOutputs } ) { selectedInputs = Utxo.emptyRefDict, createdOutputs = [] } - mergedSelection + allSelections {-| Helper function to update Tx inputs/outputs after coin selection. -} updateInputsOutputs : ProcessedIntents -> { selectedInputs : Utxo.RefDict Output, createdOutputs : List Output } -> InputsOutputs -> InputsOutputs updateInputsOutputs intents { selectedInputs, createdOutputs } old = - { referenceInputs = [] -- TODO: handle reference inputs + -- reference inputs do not change with UTxO selection, only spent inputs + { referenceInputs = old.referenceInputs , spentInputs = let preSelected : Utxo.RefDict () @@ -842,20 +1289,24 @@ updateInputsOutputs intents { selectedInputs, createdOutputs } old = Dict.Any.map (\_ _ -> ()) selectedInputs in Dict.Any.keys (Dict.Any.union preSelected algoSelected) - , createdOutputs = .outputs (intents.preCreated old) ++ createdOutputs + , createdOutputs = (intents.preCreated old).outputs ++ createdOutputs } {-| Build the Transaction from the processed intents and the latest inputs/outputs. -} -buildTx : ProcessedIntents -> InputsOutputs -> Transaction -buildTx processedIntents inputsOutputs = +buildTx : + Utxo.RefDict Output + -> Natural + -> CoinSelection.Selection + -> ProcessedIntents + -> ProcessedOtherInfo + -> InputsOutputs + -> Transaction +buildTx localStateUtxos feeAmount collateralSelection processedIntents otherInfo inputsOutputs = let - sortedWithdrawals : List ( StakeAddress, Natural, Maybe Data ) - sortedWithdrawals = - Dict.Any.toList processedIntents.withdrawals - |> List.map (\( addr, w ) -> ( addr, w.amount, Maybe.map (\f -> f inputsOutputs) w.redeemer )) - + -- WitnessSet ###################################### + -- ( nativeScripts, nativeScriptRefs ) = splitWitnessSources processedIntents.nativeScriptSources @@ -865,32 +1316,6 @@ buildTx processedIntents inputsOutputs = ( datumWitnessValues, datumWitnessRefs ) = splitWitnessSources processedIntents.datumSources - -- Regroup all OutputReferences from witnesses - -- TODO: better handle inputsOutputs.referenceInputs? - allReferenceInputs = - List.concat [ inputsOutputs.referenceInputs, nativeScriptRefs, plutusScriptRefs, datumWitnessRefs ] - - txBody : TransactionBody - txBody = - { inputs = inputsOutputs.spentInputs - , outputs = inputsOutputs.createdOutputs - , fee = Just Natural.zero -- TODO - , ttl = Nothing -- TODO - , certificates = [] -- TODO - , withdrawals = List.map (\( addr, amount, _ ) -> ( addr, amount )) sortedWithdrawals - , update = Nothing -- TODO - , auxiliaryDataHash = Nothing -- TODO - , validityIntervalStart = Nothing -- TODO - , mint = processedIntents.totalMinted - , scriptDataHash = Nothing -- TODO - , collateral = [] -- TODO - , requiredSigners = processedIntents.requiredSigners - , networkId = Nothing -- TODO - , collateralReturn = Nothing -- TODO - , totalCollateral = Nothing -- TODO - , referenceInputs = allReferenceInputs - } - -- Compute datums for pre-selected inputs. preSelected : Utxo.RefDict (Maybe Data) preSelected = @@ -939,6 +1364,11 @@ buildTx processedIntents inputsOutputs = ) |> List.filterMap identity + sortedWithdrawals : List ( StakeAddress, Natural, Maybe Data ) + sortedWithdrawals = + Dict.Any.toList processedIntents.withdrawals + |> List.map (\( addr, w ) -> ( addr, w.amount, Maybe.map (\f -> f inputsOutputs) w.redeemer )) + -- Build the withdrawals redeemers while keeping the index in the sorted list. sortedWithdrawalsRedeemers : List Redeemer sortedWithdrawalsRedeemers = @@ -954,10 +1384,30 @@ buildTx processedIntents inputsOutputs = sortedCertRedeemers = [] + -- Look for inputs at addresses that will need signatures + walletCredsInInputs : List (Bytes CredentialHash) + walletCredsInInputs = + inputsOutputs.spentInputs + |> List.filterMap + (\ref -> + Dict.Any.get ref localStateUtxos + |> Maybe.andThen (Address.extractPubKeyHash << .address) + ) + + -- Create a dummy VKey Witness for each input wallet address or required signer + -- so that fees are correctly estimated. + dummyVKeyWitness : List VKeyWitness + dummyVKeyWitness = + (walletCredsInInputs ++ processedIntents.requiredSigners) + |> List.map (\cred -> ( cred, { vkey = dummyBytes 32, signature = dummyBytes 64 } )) + -- Convert to a BytesMap to ensure credentials unicity + |> Map.fromList + |> Map.values + txWitnessSet : WitnessSet txWitnessSet = - { vkeywitness = Nothing -- TODO - , bootstrapWitness = Nothing -- TODO + { vkeywitness = nothingIfEmptyList dummyVKeyWitness + , bootstrapWitness = Nothing , plutusData = nothingIfEmptyList datumWitnessValues , nativeScripts = nothingIfEmptyList nativeScripts , plutusV1Script = nothingIfEmptyList <| filterScriptVersion PlutusV1 plutusScripts @@ -971,11 +1421,106 @@ buildTx processedIntents inputsOutputs = , sortedCertRedeemers ] } + + -- AuxiliaryData ################################### + -- + txAuxData : Maybe AuxiliaryData + txAuxData = + case otherInfo.metadata of + [] -> + Nothing + + _ -> + Just + { labels = List.map (\{ tag, metadata } -> ( tag, metadata )) otherInfo.metadata + , nativeScripts = [] + , plutusV1Scripts = [] + , plutusV2Scripts = [] + } + + -- TransactionBody ################################# + -- + -- Regroup all OutputReferences from witnesses + allReferenceInputs = + List.concat + [ inputsOutputs.referenceInputs + , otherInfo.referenceInputs + , nativeScriptRefs + , plutusScriptRefs + , datumWitnessRefs + ] + |> List.map (\ref -> ( ref, () )) + |> Utxo.refDictFromList + |> Dict.Any.keys + + -- Helper function to create dummy bytes, mostly for fee estimation + dummyBytes bytesLength = + Bytes.fromStringUnchecked (String.repeat (2 * bytesLength) "0") + + -- Script data is serialized in a very specific way to compute the hash. + -- See Conway CDDL format: https://github.com/IntersectMBO/cardano-ledger/blob/676ffc5c3e0dddb2b1ddeb76627541b195fefb5a/eras/conway/impl/cddl-files/conway.cddl#L197 + -- See Blaze impl: https://github.com/butaneprotocol/blaze-cardano/blob/1c9c603755e5d48b6bf91ea086d6231d6d8e76df/packages/blaze-tx/src/tx.ts#L935 + -- See cardano-js-sdk serialization of redeemers: https://github.com/input-output-hk/cardano-js-sdk/blob/0d138c98ccf7ad15a495f02e4a50d84f661a9d38/packages/core/src/Serialization/TransactionWitnessSet/Redeemer/Redeemers.ts#L29 + scriptDataHash : Maybe (Bytes ScriptDataHash) + scriptDataHash = + if txWitnessSet.redeemer == Nothing && txWitnessSet.plutusData == Nothing then + Nothing + + else + -- TODO: actual hashing + Just (dummyBytes 32) + + collateralReturnAmount = + (Maybe.withDefault Value.zero collateralSelection.change).lovelace + + collateralReturn : Maybe Output + collateralReturn = + List.head collateralSelection.selectedUtxos + |> Maybe.map (\( _, output ) -> Utxo.fromLovelace output.address collateralReturnAmount) + + totalCollateral : Maybe Int + totalCollateral = + if List.isEmpty collateralSelection.selectedUtxos then + Nothing + + else + collateralSelection.selectedUtxos + |> List.foldl (\( _, o ) -> Natural.add o.amount.lovelace) Natural.zero + |> Natural.toInt + |> Just + + txBody : TransactionBody + txBody = + { inputs = inputsOutputs.spentInputs + , outputs = inputsOutputs.createdOutputs + , fee = Just feeAmount + , ttl = Maybe.map .end otherInfo.timeValidityRange + , certificates = [] -- TODO + , withdrawals = List.map (\( addr, amount, _ ) -> ( addr, amount )) sortedWithdrawals + , update = Nothing + , auxiliaryDataHash = + case otherInfo.metadata of + [] -> + Nothing + + _ -> + -- TODO: compute actual auxiliary data hash + Just (dummyBytes 32) + , validityIntervalStart = Maybe.map .start otherInfo.timeValidityRange + , mint = processedIntents.totalMinted + , scriptDataHash = scriptDataHash + , collateral = List.map Tuple.first collateralSelection.selectedUtxos + , requiredSigners = processedIntents.requiredSigners + , networkId = Nothing -- not mandatory + , collateralReturn = collateralReturn + , totalCollateral = totalCollateral + , referenceInputs = allReferenceInputs + } in { body = txBody , witnessSet = txWitnessSet , isValid = True - , auxiliaryData = Nothing -- TODO + , auxiliaryData = txAuxData } @@ -1021,6 +1566,29 @@ filterScriptVersion v = ) +{-| Final check for the Tx fees. +-} +checkInsufficientFee : Fee -> Transaction -> Result TxFinalizationError Transaction +checkInsufficientFee fee tx = + let + declaredFee = + Maybe.withDefault Natural.zero tx.body.fee + + computedFee = + Transaction.computeFees tx + in + if declaredFee |> Natural.isLessThan computedFee then + case fee of + ManualFee perAddressFee -> + Err <| InsufficientManualFee { declared = declaredFee, computed = computedFee } + + AutoFee _ -> + Err <| FailurePleaseReportToElmCardano "Insufficient AutoFee. Maybe we need another buildTx round?" + + else + Ok tx + + -- EXAMPLES ########################################################## @@ -1102,6 +1670,11 @@ prettyCred cred = "script:" ++ (Bytes.toText >> Maybe.withDefault "") b +prettyWithdrawal : ( StakeAddress, Natural ) -> String +prettyWithdrawal ( { stakeCredential }, amount ) = + "₳ " ++ Natural.toString amount ++ " @ stakeCred:" ++ prettyCred stakeCredential + + prettyValue : Value -> List String prettyValue { lovelace, assets } = if MultiAsset.isEmpty assets then @@ -1189,6 +1762,13 @@ prettyMints sectionTitle multiAsset = :: List.map (indent 3) (prettyAssets Integer.toString multiAsset) +prettyVKeyWitness { vkey, signature } = + String.join ", " + [ "vkey:" ++ Bytes.toString vkey + , "signature:" ++ Bytes.toString signature + ] + + prettyRedeemer redeemer = String.join " " [ Debug.toString redeemer.tag @@ -1198,6 +1778,10 @@ prettyRedeemer redeemer = ] +prettyMetadata ( tag, metadatum ) = + Natural.toString tag ++ ": " ++ prettyCbor Metadatum.toCbor metadatum + + indent spaces str = String.repeat spaces " " ++ str @@ -1210,21 +1794,29 @@ prettyTx tx = body = List.concat - [ prettyList "Tx ref inputs:" prettyInput tx.body.referenceInputs + [ [ "Tx fee: ₳ " ++ (Maybe.withDefault Natural.zero tx.body.fee |> Natural.toString) ] + , prettyList "Tx ref inputs:" prettyInput tx.body.referenceInputs , prettyList "Tx inputs:" prettyInput tx.body.inputs , [ "Tx outputs:" ] , List.concatMap prettyOutput tx.body.outputs |> List.map (indent 3) , prettyMints "Tx mints:" tx.body.mint - , [] -- TODO: witdrawals + , prettyList "Tx withdrawals:" prettyWithdrawal tx.body.withdrawals , prettyList "Tx required signers:" prettyBytes tx.body.requiredSigners - , [] -- TODO: collateral + , prettyList + ("Tx collateral (total: ₳ " ++ String.fromInt (Maybe.withDefault 0 tx.body.totalCollateral) ++ "):") + prettyInput + tx.body.collateral + , Maybe.map prettyOutput tx.body.collateralReturn + |> Maybe.withDefault [] + |> prettyList "Tx collateral return:" identity ] witnessSet = List.concat <| List.filterMap identity - [ Nothing -- TODO: vkeywitness + [ tx.witnessSet.vkeywitness + |> Maybe.map (prettyList "Tx vkey witness:" prettyVKeyWitness) , tx.witnessSet.nativeScripts |> Maybe.map (prettyList "Tx native scripts:" (prettyScript << Script.Native)) , tx.witnessSet.plutusV1Script @@ -1236,11 +1828,21 @@ prettyTx tx = , Nothing -- TODO: plutusData ] - -- TODO: pretty print auxiliary data - auxData = - [] + -- Pretty print auxiliary data + auxiliaryData = + case tx.auxiliaryData of + Nothing -> + [] + + Just auxData -> + List.concat <| + [ prettyList "Tx metadata:" prettyMetadata auxData.labels + , prettyList "Tx native scripts in auxiliary data:" (prettyScript << Script.Native) auxData.nativeScripts + , prettyList "Tx plutus V1 scripts in auxiliary data:" prettyBytes auxData.plutusV1Scripts + , prettyList "Tx plutus V2 scripts in auxiliary data:" prettyBytes auxData.plutusV2Scripts + ] in - List.concat [ body, witnessSet, auxData ] + List.concat [ body, witnessSet, auxiliaryData ] |> String.join "\n" @@ -1263,20 +1865,32 @@ exAddr = dog = - { scriptRef = makeRef "dogScriptRef" 0 - , policyId = Bytes.fromText "dog" + { policyId = Bytes.fromText "dog" , policyIdStr = "dog" , assetName = Bytes.fromText "yksoh" , assetNameStr = "yksoh" + , scriptRef = makeRef "dogScriptRef" 0 + , refOutput = + { address = makeAddress "dogScriptRefAddress" + , amount = ada.two + , datumOption = Nothing + , referenceScript = Just <| Script.Native <| Script.ScriptAll [] -- dummy + } } cat = - { scriptRef = makeRef "catScriptRef" 0 - , policyId = Bytes.fromText "cat" + { policyId = Bytes.fromText "cat" , policyIdStr = "cat" , assetName = Bytes.fromText "felix" , assetNameStr = "felix" + , scriptRef = makeRef "catScriptRef" 0 + , refOutput = + { address = makeAddress "catScriptRefAddress" + , amount = ada.two + , datumOption = Nothing + , referenceScript = Just <| Script.Native <| Script.ScriptAll [] -- dummy + } } @@ -1288,6 +1902,8 @@ globalStateUtxos = , makeAdaOutput 2 exAddr.me 5 -- 5 ada at my address , makeAsset 3 exAddr.me dog.policyIdStr dog.assetNameStr 2 , makeAsset 4 exAddr.me cat.policyIdStr cat.assetNameStr 5 + , ( dog.scriptRef, dog.refOutput ) + , ( cat.scriptRef, cat.refOutput ) ] @@ -1297,6 +1913,14 @@ configGlobalLargest = } +twoAdaFee = + ManualFee [ { paymentSource = exAddr.me, exactFeeAmount = Natural.fromSafeInt 2000000 } ] + + +autoFee = + AutoFee { paymentSource = exAddr.me } + + -- EXAMPLE 1: Simple transfer @@ -1305,7 +1929,7 @@ example1 _ = [ Spend <| From exAddr.me ada.one , SendTo exAddr.you ada.one ] - |> finalize configGlobalLargest [] + |> finalize configGlobalLargest autoFee [ TxMetadata { tag = Natural.fromSafeInt 14, metadata = Metadatum.Int (Integer.fromSafeInt 42) } ] @@ -1329,11 +1953,29 @@ example2 _ = , scriptWitness = NativeWitness (WitnessReference cat.scriptRef) } ] - |> finalize configGlobalLargest [] + |> finalize configGlobalLargest autoFee [] -- EXAMPLE 3: spend from a Plutus script +-- The input index is provided in the redeemer + + +utxoBeingSpent = + makeRef "previouslySentToLock" 0 + + +findSpendingUtxo inputs = + case inputs of + [] -> + 0 + + ( id, ref ) :: next -> + if ref == utxoBeingSpent then + id + + else + findSpendingUtxo next example3 _ = @@ -1358,10 +2000,11 @@ example3 _ = , stakeCredential = myStakeCred } - -- Dummy redeemer of the smallest size possible. - -- A redeemer is mandatory, but unchecked by this contract anyway. - dummyRedeemer = - Data.Int Integer.zero + -- Build a redeemer that contains the index of the spent script input. + redeemer inputsOutputs = + List.indexedMap Tuple.pair inputsOutputs.spentInputs + |> findSpendingUtxo + |> (Data.Int << Integer.fromSafeInt) -- Helper function to create an output at the lock script address. -- It contains our key credential in the datum. @@ -1375,17 +2018,17 @@ example3 _ = -- Add to local state utxos some previously sent 2 ada. localStateUtxos = configGlobalLargest.localStateUtxos - |> Dict.Any.insert (makeRef "previouslySentToLock" 0) + |> Dict.Any.insert utxoBeingSpent (makeLockedOutput ada.two) in -- Collect 1 ada from the lock script [ Spend <| FromPlutusScript - { spentInput = makeRef "previouslySentToLock" 0 + { spentInput = utxoBeingSpent , datumWitness = Nothing , plutusScriptWitness = { script = WitnessValue lock.script - , redeemerData = \_ -> dummyRedeemer + , redeemerData = redeemer , requiredSigners = [ myKeyCred ] } } @@ -1394,4 +2037,4 @@ example3 _ = -- Return the other 1 ada to the lock script (there was 2 ada initially) , SendToOutput (\_ -> makeLockedOutput ada.one) ] - |> finalize { configGlobalLargest | localStateUtxos = localStateUtxos } [] + |> finalize { configGlobalLargest | localStateUtxos = localStateUtxos } autoFee [] diff --git a/src/Cardano/Address.elm b/src/Cardano/Address.elm index 81d51c8..c5017c3 100644 --- a/src/Cardano/Address.elm +++ b/src/Cardano/Address.elm @@ -2,9 +2,9 @@ module Cardano.Address exposing ( Address(..), StakeAddress, NetworkId(..), ByronAddress , Credential(..), StakeCredential(..), StakeCredentialPointer, CredentialHash , enterprise, script, base, pointer - , extractPubKeyHash, extractStakeCredential - , Dict, emptyDict - , StakeDict, emptyStakeDict + , isShelleyWallet, extractPubKeyHash, extractStakeCredential + , Dict, emptyDict, dictFromList + , StakeDict, emptyStakeDict, stakeDictFromList , toCbor, stakeAddressToCbor, credentialToCbor, encodeNetworkId , decode, decodeReward ) @@ -17,11 +17,11 @@ module Cardano.Address exposing @docs enterprise, script, base, pointer -@docs extractPubKeyHash, extractStakeCredential +@docs isShelleyWallet, extractPubKeyHash, extractStakeCredential -@docs Dict, emptyDict +@docs Dict, emptyDict, dictFromList -@docs StakeDict, emptyStakeDict +@docs StakeDict, emptyStakeDict, stakeDictFromList @docs toCbor, stakeAddressToCbor, credentialToCbor, encodeNetworkId @@ -155,6 +155,13 @@ pointer networkId paymentCredential p = } +{-| Check if an [Address] is of the Shelley type, with a wallet payment key, not a script. +-} +isShelleyWallet : Address -> Bool +isShelleyWallet address = + extractPubKeyHash address /= Nothing + + {-| Extract the pubkey hash of a Shelley wallet address. -} extractPubKeyHash : Address -> Maybe (Bytes CredentialHash) @@ -186,6 +193,9 @@ extractStakeCredential address = {-| Convenient alias for a `Dict` with [Address] keys. When converting to a `List`, its keys are sorted by address. + +WARNING: do not compare them with `==` since they contain functions. + -} type alias Dict a = AnyDict String Address a @@ -193,14 +203,31 @@ type alias Dict a = {-| Initialize an empty address dictionary. For other operations, use the `AnyDict` module directly. + +WARNING: do not compare them with `==` since they contain functions. + -} emptyDict : Dict a emptyDict = Dict.Any.empty (toCbor >> E.encode >> Bytes.fromBytes >> Bytes.toString) +{-| Create an address dictionary from a list. +For other operations, use the `AnyDict` module directly. + +WARNING: do not compare them with `==` since they contain functions. + +-} +dictFromList : List ( Address, a ) -> Dict a +dictFromList = + Dict.Any.fromList (toCbor >> E.encode >> Bytes.fromBytes >> Bytes.toString) + + {-| Convenient alias for a `Dict` with [StakeAddress] keys. When converting to a `List`, its keys are sorted by stake address. + +WARNING: do not compare them with `==` since they contain functions. + -} type alias StakeDict a = AnyDict String StakeAddress a @@ -208,12 +235,26 @@ type alias StakeDict a = {-| Initialize an empty stake address dictionary. For other operations, use the `AnyDict` module directly. + +WARNING: do not compare them with `==` since they contain functions. + -} emptyStakeDict : StakeDict a emptyStakeDict = Dict.Any.empty (stakeAddressToCbor >> E.encode >> Bytes.fromBytes >> Bytes.toString) +{-| Create a stake address dictionary from a list. +For other operations, use the `AnyDict` module directly. + +WARNING: do not compare them with `==` since they contain functions. + +-} +stakeDictFromList : List ( StakeAddress, a ) -> StakeDict a +stakeDictFromList = + Dict.Any.fromList (stakeAddressToCbor >> E.encode >> Bytes.fromBytes >> Bytes.toString) + + {-| Encode an [Address] to CBOR. Byron addresses are left untouched as we don't plan to have full support of Byron era. diff --git a/src/Cardano/CoinSelection.elm b/src/Cardano/CoinSelection.elm index 002bd51..515291f 100644 --- a/src/Cardano/CoinSelection.elm +++ b/src/Cardano/CoinSelection.elm @@ -31,7 +31,7 @@ import Natural as N exposing (Natural) -} type Error = MaximumInputCountExceeded - | UTxOBalanceInsufficient + | UTxOBalanceInsufficient { selectedUtxos : List ( OutputReference, Output ), missingValue : Value } {-| Represents the result of a successful coin selection. @@ -77,6 +77,8 @@ largestFirst maxInputCount context = MultiAsset.split context.targetAmount.assets sortedAvailableUtxoByLovelace = + -- TODO: actually use the "free" lovelace, by substracting the UTxO minAda for sorting + -- Create and use a function called "Utxo.compareFreeLovelace" List.sortWith (\( _, o1 ) ( _, o2 ) -> reverseOrder Utxo.compareLovelace o1 o2) context.availableUtxos in -- Select for Ada first @@ -98,9 +100,12 @@ largestFirst maxInputCount context = Nothing else - Just (Value.substract state.accumulatedAmount context.targetAmount) + Just (Value.substract state.accumulatedAmount context.targetAmount |> Value.normalize) } ) + -- TODO: if possible, remove extraneous inputs. + -- Indeed, when selecting later CNT, they might contain enough previous CNT too. + |> identity type alias SelectionState = @@ -163,7 +168,14 @@ accumOutputsUntilDone ({ maxInputCount, selectedInputCount, accumulatedAmount, t else if not (Value.atLeast targetAmount accumulatedAmount) then case availableOutputs of [] -> - Err UTxOBalanceInsufficient + Err + (UTxOBalanceInsufficient + { selectedUtxos = selectedOutputs + , missingValue = + Value.substract targetAmount accumulatedAmount + |> Value.normalize + } + ) utxo :: utxos -> accumOutputsUntilDone diff --git a/src/Cardano/MultiAsset.elm b/src/Cardano/MultiAsset.elm index 0ad746f..4a73b52 100644 --- a/src/Cardano/MultiAsset.elm +++ b/src/Cardano/MultiAsset.elm @@ -84,10 +84,10 @@ onlyToken policy name amount = {-| Remove assets with 0 amounts. -} -normalize : MultiAsset Natural -> MultiAsset Natural -normalize multiAsset = +normalize : (int -> Bool) -> MultiAsset int -> MultiAsset int +normalize deletionCheck multiAsset = multiAsset - |> Bytes.Map.map (Bytes.Map.filter (not << Natural.isZero)) + |> Bytes.Map.map (Bytes.Map.filter (not << deletionCheck)) |> Bytes.Map.filter (not << Bytes.Map.isEmpty) diff --git a/src/Cardano/Transaction.elm b/src/Cardano/Transaction.elm index bc5f3a2..6bb5685 100644 --- a/src/Cardano/Transaction.elm +++ b/src/Cardano/Transaction.elm @@ -1,7 +1,7 @@ module Cardano.Transaction exposing - ( Transaction - , TransactionBody, AuxiliaryDataHash, ScriptDataHash - , WitnessSet + ( Transaction, new + , TransactionBody, newBody, AuxiliaryDataHash, ScriptDataHash + , WitnessSet, newWitnessSet , Update, ProtocolParamUpdate, Nonce(..), ProtocolVersion, noParamUpdate , ScriptContext, ScriptPurpose(..) , Certificate(..), PoolId, GenesisHash, GenesisDelegateHash, VrfKeyHash, RewardSource(..), RewardTarget(..), MoveInstantaneousReward @@ -9,16 +9,17 @@ module Cardano.Transaction exposing , CostModels, ExUnitPrices , RationalNumber, UnitInterval, PositiveInterval , VKeyWitness, BootstrapWitness, Ed25519PublicKey, Ed25519Signature, BootstrapWitnessChainCode, BootstrapWitnessAttributes + , computeFees , deserialize, serialize ) {-| Types and functions related to on-chain transactions. -@docs Transaction +@docs Transaction, new -@docs TransactionBody, AuxiliaryDataHash, ScriptDataHash +@docs TransactionBody, newBody, AuxiliaryDataHash, ScriptDataHash -@docs WitnessSet +@docs WitnessSet, newWitnessSet @docs Update, ProtocolParamUpdate, Nonce, ProtocolVersion, noParamUpdate @@ -34,6 +35,8 @@ module Cardano.Transaction exposing @docs VKeyWitness, BootstrapWitness, Ed25519PublicKey, Ed25519Signature, BootstrapWitnessChainCode, BootstrapWitnessAttributes +@docs computeFees + @docs deserialize, serialize -} @@ -66,6 +69,17 @@ type alias Transaction = } +{-| Helper for empty [Transaction] initialization. +-} +new : Transaction +new = + { body = newBody + , witnessSet = newWitnessSet + , isValid = True + , auxiliaryData = Nothing + } + + {-| A Cardano transaction body. -} type alias TransactionBody = @@ -103,6 +117,30 @@ type ScriptDataHash = ScriptDataHash Never +{-| Helper for empty transaction body initialization. +-} +newBody : TransactionBody +newBody = + { inputs = [] + , outputs = [] + , fee = Nothing + , ttl = Nothing + , certificates = [] + , withdrawals = [] + , update = Nothing + , auxiliaryDataHash = Nothing + , validityIntervalStart = Nothing + , mint = MultiAsset.empty + , scriptDataHash = Nothing + , collateral = [] + , requiredSigners = [] + , networkId = Nothing + , collateralReturn = Nothing + , totalCollateral = Nothing + , referenceInputs = [] + } + + {-| A Cardano transaction witness set. [Pallas alonzo implementation][pallas] @@ -121,6 +159,20 @@ type alias WitnessSet = } +{-| Helper for empty witness set initialization. +-} +newWitnessSet : WitnessSet +newWitnessSet = + { vkeywitness = Nothing + , nativeScripts = Nothing + , bootstrapWitness = Nothing + , plutusV1Script = Nothing + , plutusData = Nothing + , redeemer = Nothing + , plutusV2Script = Nothing + } + + {-| Payload to update the protocol parameters at a specific epoch -} type alias Update = @@ -432,6 +484,54 @@ type RewardTarget | OtherAccountingPot Natural +{-| Re-compute fees for a transaction (does not read `body.fee`). +-} +computeFees : Transaction -> Natural +computeFees tx = + let + ( baseFee, feePerByte ) = + -- TODO: check those values + ( 155381, 44 ) + + priceStep = + { numerator = Natural.fromSafeInt 721 -- TODO: check those values + , denominator = Natural.fromSafeInt 10000000 + } + + priceMem = + { numerator = Natural.fromSafeInt 577 -- TODO: check those values + , denominator = Natural.fromSafeInt 10000 + } + + txSize = + Bytes.width (serialize tx) + + ( totalSteps, totalMem ) = + tx.witnessSet.redeemer + |> Maybe.withDefault [] + |> List.foldl + (\r ( steps, mem ) -> + ( Natural.add steps <| Natural.fromSafeInt r.exUnits.steps + , Natural.add mem <| Natural.fromSafeInt r.exUnits.mem + ) + ) + ( Natural.zero, Natural.zero ) + + totalStepsCost = + Natural.mul totalSteps priceStep.numerator + |> Natural.divBy priceStep.denominator + |> Maybe.withDefault Natural.zero + + totalMemCost = + Natural.mul totalMem priceMem.numerator + |> Natural.divBy priceMem.denominator + |> Maybe.withDefault Natural.zero + in + Natural.fromSafeInt (baseFee + feePerByte * txSize) + |> Natural.add totalStepsCost + |> Natural.add totalMemCost + + -- https://github.com/input-output-hk/cardano-ledger/blob/a792fbff8156773e712ef875d82c2c6d4358a417/eras/babbage/test-suite/cddl-files/babbage.cddl#L13 @@ -1372,40 +1472,6 @@ decodeNetworkId = -- Helper definitions -newBody : TransactionBody -newBody = - { inputs = [] - , outputs = [] - , fee = Nothing - , ttl = Nothing - , certificates = [] - , withdrawals = [] - , update = Nothing - , auxiliaryDataHash = Nothing - , validityIntervalStart = Nothing - , mint = MultiAsset.empty - , scriptDataHash = Nothing - , collateral = [] - , requiredSigners = [] - , networkId = Nothing - , collateralReturn = Nothing - , totalCollateral = Nothing - , referenceInputs = [] - } - - -newWitnessSet : WitnessSet -newWitnessSet = - { vkeywitness = Nothing - , nativeScripts = Nothing - , bootstrapWitness = Nothing - , plutusV1Script = Nothing - , plutusData = Nothing - , redeemer = Nothing - , plutusV2Script = Nothing - } - - setInputs : List OutputReference -> TransactionBody -> TransactionBody setInputs inputs body = { body | inputs = inputs } diff --git a/src/Cardano/Utxo.elm b/src/Cardano/Utxo.elm index 3478365..6ea80ce 100644 --- a/src/Cardano/Utxo.elm +++ b/src/Cardano/Utxo.elm @@ -1,9 +1,9 @@ module Cardano.Utxo exposing ( OutputReference, TransactionId, Output, DatumHash, DatumOption(..) , RefDict, emptyRefDict, refDictFromList - , fromLovelace - , lovelace, totalLovelace, compareLovelace - , minAda + , fromLovelace, simpleOutput + , lovelace, totalLovelace, compareLovelace, isAdaOnly + , minAda, checkMinAda, minAdaForAssets , encodeOutputReference, encodeOutput, encodeDatumOption , decodeOutputReference, decodeOutput ) @@ -23,17 +23,17 @@ module Cardano.Utxo exposing ## Build -@docs fromLovelace +@docs fromLovelace, simpleOutput ## Query -@docs lovelace, totalLovelace, compareLovelace +@docs lovelace, totalLovelace, compareLovelace, isAdaOnly ## Compute -@docs minAda +@docs minAda, checkMinAda, minAdaForAssets ## Convert @@ -47,6 +47,7 @@ module Cardano.Utxo exposing import Bytes.Comparable as Bytes exposing (Bytes) import Cardano.Address as Address exposing (Address) import Cardano.Data as Data exposing (Data) +import Cardano.MultiAsset as MultiAsset exposing (MultiAsset) import Cardano.Script as Script exposing (Script) import Cardano.Value as Value exposing (Value) import Cbor.Decode as D @@ -75,12 +76,18 @@ type TransactionId {-| Convenience type for `Dict` with [OutputReference] keys. + +WARNING: do not compare them with `==` since they contain functions. + -} type alias RefDict a = AnyDict ( String, Int ) OutputReference a {-| Convenience empty initialization for `Dict` with [OutputReference] keys. + +WARNING: do not compare them with `==` since they contain functions. + -} emptyRefDict : RefDict a emptyRefDict = @@ -88,6 +95,9 @@ emptyRefDict = {-| Convenience function to create a `Dict` with [OutputReference] keys from a list. + +WARNING: do not compare them with `==` since they contain functions. + -} refDictFromList : List ( OutputReference, a ) -> RefDict a refDictFromList = @@ -142,11 +152,14 @@ compareLovelace a b = -} fromLovelace : Address -> Natural -> Output fromLovelace address amount = - { address = address - , amount = Value.onlyLovelace amount - , datumOption = Nothing - , referenceScript = Nothing - } + simpleOutput address (Value.onlyLovelace amount) + + +{-| Create a simple [Output] with just an [Address] and a [Value]. +-} +simpleOutput : Address -> Value -> Output +simpleOutput address value = + { address = address, amount = value, datumOption = Nothing, referenceScript = Nothing } {-| Extract the amount of lovelace in an `Output` @@ -163,8 +176,21 @@ totalLovelace = List.foldr (\output total -> N.add (lovelace output) total) N.zero +{-| Check if the output contains only Ada. +Nothing else is allowed, no tokens, no datum, no ref script. +-} +isAdaOnly : Output -> Bool +isAdaOnly { amount, datumOption, referenceScript } = + (amount.assets == MultiAsset.empty) + && (datumOption == Nothing) + && (referenceScript == Nothing) + + {-| Compute minimum Ada lovelace for a given [Output]. +Since the size of the lovelace field may impact minAda, +we adjust its value if it is too low before computation. + The formula is given by CIP 55, with current value of `4310` for `coinsPerUTxOByte`. @@ -172,12 +198,47 @@ TODO: provide `coinsPerUTxOByte` in function arguments? -} minAda : Output -> Natural -minAda output = - E.encode (encodeOutput output) +minAda ({ amount } as output) = + let + -- make sure lovelace is encoded with at least 32 bits (so >= 2^16) + updatedOutput = + if amount.lovelace |> N.isLessThan (N.fromSafeInt <| 2 ^ 16) then + { output | amount = { amount | lovelace = N.fromSafeInt <| 2 ^ 16 } } + + else + output + in + E.encode (encodeOutput updatedOutput) |> (Bytes.fromBytes >> Bytes.width) |> (\w -> N.fromSafeInt ((160 + w) * 4310)) +{-| Check that an [Output] has enough ada to cover its size. +-} +checkMinAda : Output -> Result String Output +checkMinAda output = + let + outputMinAda = + minAda output + in + if lovelace output |> N.isGreaterThanOrEqual outputMinAda then + Ok output + + else + Err ("Output has less ada than its required min ada (" ++ N.toString outputMinAda ++ "):\n" ++ Debug.toString output) + + +{-| Compute minimum Ada lovelace for a given [MultiAsset] that would be sent to a given address. + +TODO: provide `coinsPerUTxOByte` in function arguments? + +-} +minAdaForAssets : Address -> MultiAsset Natural -> Natural +minAdaForAssets address assets = + simpleOutput address { lovelace = N.fromSafeInt <| 2 ^ 16, assets = assets } + |> minAda + + {-| CBOR encoder for [Output]. -} encodeOutput : Output -> E.Encoder diff --git a/src/Cardano/Value.elm b/src/Cardano/Value.elm index 8fe4771..1767cc4 100644 --- a/src/Cardano/Value.elm +++ b/src/Cardano/Value.elm @@ -116,7 +116,7 @@ sum allValues = normalize : Value -> Value normalize v = { lovelace = v.lovelace - , assets = MultiAsset.normalize v.assets + , assets = MultiAsset.normalize Natural.isZero v.assets } diff --git a/tests/Cardano/CoinSelectionTests.elm b/tests/Cardano/CoinSelectionTests.elm index 96d507e..f382649 100644 --- a/tests/Cardano/CoinSelectionTests.elm +++ b/tests/Cardano/CoinSelectionTests.elm @@ -82,7 +82,7 @@ noOutputsTest _ = 5 in largestFirst maxInputCount context - |> Expect.equal (Err UTxOBalanceInsufficient) + |> Expect.equal (Err <| UTxOBalanceInsufficient { selectedUtxos = [], missingValue = context.targetAmount }) insufficientFundsTest : a -> Expectation @@ -98,11 +98,15 @@ insufficientFundsTest _ = , alreadySelectedUtxos = [] , targetAmount = onlyLovelace <| N.fromSafeInt 30 } - - result = - largestFirst 5 context in - Expect.equal (Err UTxOBalanceInsufficient) result + largestFirst 5 context + |> Expect.equal + (Err <| + UTxOBalanceInsufficient + { selectedUtxos = availableOutputs + , missingValue = onlyLovelace <| N.fromSafeInt 15 + } + ) singleUtxoSingleOutputEqualValueTest : a -> Expectation @@ -301,7 +305,7 @@ noOutputsMultiAssetTest _ = 5 in largestFirst maxInputCount context - |> Expect.equal (Err UTxOBalanceInsufficient) + |> Expect.equal (Err <| UTxOBalanceInsufficient { selectedUtxos = [], missingValue = context.targetAmount }) insufficientFundsMultiAssetTest : a -> Expectation @@ -317,11 +321,15 @@ insufficientFundsMultiAssetTest _ = , alreadySelectedUtxos = [] , targetAmount = token "policy" "name" 30 } - - result = - largestFirst 5 context in - Expect.equal (Err UTxOBalanceInsufficient) result + largestFirst 5 context + |> Expect.equal + (Err <| + UTxOBalanceInsufficient + { selectedUtxos = availableOutputs + , missingValue = token "policy" "name" 15 + } + ) singleUtxoSingleOutputEqualValueMultiAssetTest : a -> Expectation diff --git a/tests/Cardano/TransactionTests.elm b/tests/Cardano/TransactionTests.elm index e4efff5..4fa54f2 100644 --- a/tests/Cardano/TransactionTests.elm +++ b/tests/Cardano/TransactionTests.elm @@ -6,11 +6,10 @@ import Cardano.Address as Address exposing (NetworkId(..)) import Cardano.Data exposing (Data(..)) import Cardano.Redeemer exposing (RedeemerTag(..)) import Cardano.Script exposing (NativeScript(..)) -import Cardano.Transaction as Transaction exposing (Nonce(..), TransactionBody, WitnessSet) +import Cardano.Transaction as Transaction exposing (Nonce(..), TransactionBody, WitnessSet, newBody, newWitnessSet) import Cardano.Transaction.AuxiliaryData exposing (AuxiliaryData) import Cardano.Transaction.AuxiliaryData.Metadatum as Metadatum import Cardano.Transaction.Builder as Tx -import Cardano.Utxo as Utxo import Cardano.Value as Value import Dict exposing (Dict) import Expect @@ -136,7 +135,7 @@ decode79acf081 = txBody79acf081 : TransactionBody txBody79acf081 = - { newTxBody + { newBody | inputs = [ { transactionId = Bytes.fromStringUnchecked "397eb970e7980e6ac1eb17fcb26a8df162db4e101f776138d74bbd09ad1a9dee" , outputIndex = 0 @@ -213,7 +212,7 @@ txBody79acf081 = txWitnessSet79acf081 : Transaction.WitnessSet txWitnessSet79acf081 = - { newTxWitnessSet + { newWitnessSet | bootstrapWitness = Just [ { publicKey = Bytes.fromStringUnchecked "f202012360fa94af83651a8b8b9592bcda2bee5e187c40d4263a838107c27ae8" @@ -263,7 +262,7 @@ decode871b14fb = txBody871b14fb : TransactionBody txBody871b14fb = - { newTxBody + { newBody | inputs = [ { transactionId = Bytes.fromStringUnchecked "9a822a5601a29f7a880948cf3b6491c24d861df18dbbe6ea2ba293f9878f965f" , outputIndex = 0 @@ -298,7 +297,7 @@ txBody871b14fb = txWitnessSet871b14fb : Transaction.WitnessSet txWitnessSet871b14fb = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { vkey = Bytes.fromStringUnchecked "0607a454923b9bd5fec2897ce7f2b9ca2874ee545d750624084ba0fc9ef06dd5" @@ -336,7 +335,7 @@ decodef3a0835d = txBodyf3a0835d : TransactionBody txBodyf3a0835d = - { newTxBody + { newBody | inputs = [ { transactionId = Bytes.fromStringUnchecked "c0810285e7cffd0ea65851008392d41dd4cdf223d9263ca7a33e28a7e7b410b8" , outputIndex = 0 @@ -364,7 +363,7 @@ txBodyf3a0835d = txWitnessSetf3a0835d : Transaction.WitnessSet txWitnessSetf3a0835d = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { vkey = Bytes.fromStringUnchecked "473f36674fcde1ff195076774decda62f4b0ba860f9fcc0c51d63abee8b1e128" @@ -405,7 +404,7 @@ decode841cca81 = txBody841cca81 : TransactionBody txBody841cca81 = - { newTxBody + { newBody | inputs = [ { transactionId = Bytes.fromStringUnchecked "f3a0835d9359ed79f8301ba61ff263188c180ffd6dfddaba60a7e31b8366c38e" , outputIndex = 0 @@ -460,7 +459,7 @@ txBody841cca81 = txWitnessSet841cca81 : WitnessSet txWitnessSet841cca81 = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { vkey = Bytes.fromStringUnchecked "473f36674fcde1ff195076774decda62f4b0ba860f9fcc0c51d63abee8b1e128" @@ -504,7 +503,7 @@ decode896cf8fe = txBody896cf8fe : TransactionBody txBody896cf8fe = - { newTxBody + { newBody | inputs = [ { transactionId = Bytes.fromStringUnchecked "e1d1d61ecd706790ee31a1c07fc87827f7b9738d374ef705d1c8cff8295c8cf0" , outputIndex = 0 @@ -535,7 +534,7 @@ txBody896cf8fe = txWitnessSet896cf8fe : WitnessSet txWitnessSet896cf8fe = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { vkey = Bytes.fromStringUnchecked "6f0d127f3f5122171fec5f91e85df66bac1314680f703abf5caefddffd55a285" @@ -576,7 +575,7 @@ decode3dd8be52 = txBody3dd8be52 : TransactionBody txBody3dd8be52 = - { newTxBody + { newBody | inputs = [ { outputIndex = 1, transactionId = Bytes.fromStringUnchecked "2f744483e15d31c9a3e7407970bb01f9a4542a6cf3ab6d921477cadbc865aa67" } ] , outputs = [ { address = @@ -622,7 +621,7 @@ txBody3dd8be52 = txWitnessSet3dd8be52 : WitnessSet txWitnessSet3dd8be52 = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "6a368d10744c8ca8d84e3f664a1e0aac6b3c5e53bd6b32f5fa9490213310eb6b5d4c5d9487cd6705dc11b44558a3df9d0538a6f8fc05858c9fa40d48d8dc560a" @@ -675,7 +674,7 @@ decode3c03090c = txBody3c03090c : TransactionBody txBody3c03090c = - { newTxBody + { newBody | inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "f9785983a5480c77407ad35b2e533256f26859a99567e4259ed5a5d6d7b00238" } ] , outputs = [ { address = @@ -713,7 +712,7 @@ txBody3c03090c = txWitnessSet3c03090c : WitnessSet txWitnessSet3c03090c = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "72bbd8363b2da559d75722353ae5a0791cd76ca804718c2c4c99a37c7c2add4b8c4fe0ba4d1fa80f837d595b8404b12f6301a3d73b8b88f6f7b811c60cf67b08" @@ -757,7 +756,7 @@ decode35d2728e = txBody35d2728e : TransactionBody txBody35d2728e = - { newTxBody + { newBody | inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "2dcf5b56aa5d63bd346b1196b8dadc3bb32cafa3a7e080b04339d105e4637d17" } ] , outputs = [ { address = Address.Shelley { networkId = Mainnet, paymentCredential = Address.VKeyHash (Bytes.fromStringUnchecked "d80fe69ded1ff90f41e526d0332a2ff98ba8a0d85ceb8941b5178420"), stakeCredential = Nothing } @@ -1181,7 +1180,7 @@ txBody35d2728e = txWitnessSet35d2728e : WitnessSet txWitnessSet35d2728e = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "04f7d6e3c5af19cf76ec46b6a876f688c5ea83f8bfd6cac4b26fb5944622584a1cd8a986bfef66a25dac652ec4d6004b2f250dce9d60e3a4efdb2e8520d2a403" @@ -1240,7 +1239,7 @@ decodea2d8a927 = txBodya2d8a927 : TransactionBody txBodya2d8a927 = - { newTxBody + { newBody | fee = Just (N.fromSafeInt 215651) , inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "a6afff5e962033731b67a256b9205fdaadc57faa06793dbde553dd26a2cd1732" } ] , outputs = @@ -1261,7 +1260,7 @@ txBodya2d8a927 = txWitnessSeta2d8a927 : WitnessSet txWitnessSeta2d8a927 = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "0c836a9aa1d5b32b7e282add2458e1a71e8828e34e6e2ad3ad50454e7bee4a3c83222d5b16d466be02d3e969684c1e09005b2c16a8ca26aabcbd344f56e8cb09" @@ -1299,7 +1298,7 @@ decode2383af05 = txBody2383af05 : TransactionBody txBody2383af05 = - { newTxBody + { newBody | fee = Just (N.fromSafeInt 1000000) , inputs = [ { outputIndex = 1, transactionId = Bytes.fromStringUnchecked "72cb2dde1d5cea967255d6dd141aaf76801840033760f452763436bd1afc3836" } ] , outputs = @@ -1316,7 +1315,7 @@ txBody2383af05 = txWitnessSet2383af05 : WitnessSet txWitnessSet2383af05 = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "fe644cc6fe77d19bf75d766d2894246a5ad9c5482be671be5a81efb6ad694215e15312895bf8bb36150d9a15c80457017c2895792ad244da1d136ed50d41f603" @@ -1357,7 +1356,7 @@ decode1bcd8fa7 = txBody1bcd8fa7 : TransactionBody txBody1bcd8fa7 = - { newTxBody + { newBody | fee = Just (N.fromSafeInt 169884) , inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "ca6267b5f2b336da224e6b5efac292f0eaf45b40f7f7b931e4b5ee21e68455d8" } ] , outputs = @@ -1378,7 +1377,7 @@ txBody1bcd8fa7 = txWitnessSet1bcd8fa7 : WitnessSet txWitnessSet1bcd8fa7 = - { newTxWitnessSet + { newWitnessSet | bootstrapWitness = Just [ { attributes = Bytes.fromStringUnchecked "a0" @@ -1435,7 +1434,7 @@ txAuxiliaryDatac220e20c = txBodyc220e20c : TransactionBody txBodyc220e20c = - { newTxBody + { newBody | auxiliaryDataHash = Just (Bytes.fromStringUnchecked "c2d2b42fbacf30eeddab1447f525297eec0ab134f8cddd2025a075c69d57e4bc") , fee = Just (N.fromSafeInt 175401) , inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "5b06f6ea129a404d5bc610880be35376625a8f7f11773bf79db1889eb3bb87eb" } ] @@ -1452,7 +1451,7 @@ txBodyc220e20c = txWitnessSetc220e20c : WitnessSet txWitnessSetc220e20c = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "57e649e46b1711bfd45cb2ae0e4ecb8c863e5c261545f0ec96fe6ee3fc8dd5b36106fd13d21e643c34e04c58b18759afaca58f990060b4342dd7369bd11b1d06" @@ -1511,7 +1510,7 @@ txAuxiliaryData254685a8 = txBody254685a8 : TransactionBody txBody254685a8 = - { newTxBody + { newBody | auxiliaryDataHash = Just (Bytes.fromStringUnchecked "27c2bbc74ce52de561afc65f4db18eaff9cf05938e570c2370bca19bf8b33c68") , fee = Just (N.fromSafeInt 176457) , inputs = [ { outputIndex = 1, transactionId = Bytes.fromStringUnchecked "d241c8e10ff0d9ac04cfed2a6d6d6f80d0250bc2a47489df7b436f0d9f769b4d" } ] @@ -1543,7 +1542,7 @@ txBody254685a8 = txWitnessSet254685a8 : WitnessSet txWitnessSet254685a8 = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "b6fff317173f5aa8eff05ae47df56b89360fe547a3a900e1db849f52e83bd0743b18da254684256d29c016ed2e3792149bdbf6c3375b7b9ff4cf12507e662e05" @@ -1581,7 +1580,7 @@ decode4a3f8676 = txBody4a3f8676 : TransactionBody txBody4a3f8676 = - { newTxBody + { newBody | fee = Just (N.fromSafeInt 500000) , inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "e7db1f809fcc21d3dd108ced6218bf0f0cbb6a0f679f848ff1790b68d3a35872" } ] , outputs = @@ -1602,7 +1601,7 @@ txBody4a3f8676 = txWitnessSet4a3f8676 : WitnessSet txWitnessSet4a3f8676 = - { newTxWitnessSet + { newWitnessSet | nativeScripts = Just [ ScriptAll @@ -1654,7 +1653,7 @@ decodee252be4c = txBodye252be4c : TransactionBody txBodye252be4c = - { newTxBody + { newBody | auxiliaryDataHash = Nothing , fee = Just (N.fromSafeInt 1000000) , inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "d9a8ae2194e2e25e8079a04a4694e2679464a4f51512863a0008a35a85762ff0" } ] @@ -1680,7 +1679,7 @@ txBodye252be4c = txWitnessSete252be4c : WitnessSet txWitnessSete252be4c = - { newTxWitnessSet + { newWitnessSet | bootstrapWitness = Nothing , nativeScripts = Just [ ScriptAll [ InvalidHereafter (N.fromSafeInt 24285375), ScriptPubkey (Bytes.fromStringUnchecked "e97316c52c85eab276fd40feacf78bc5eff74e225e744567140070c3") ] ] , vkeywitness = @@ -1723,7 +1722,7 @@ decodefc863a44 = txBodyfc863a44 : TransactionBody txBodyfc863a44 = - { newTxBody + { newBody | fee = Just (N.fromSafeInt 217553) , inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "bf30608a974d09c56dd62ca10199ec11746ea2d90dbd83649d4f37c629b1ba84" } ] , outputs = @@ -1760,7 +1759,7 @@ txBodyfc863a44 = txWitnessSetfc863a44 : WitnessSet txWitnessSetfc863a44 = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "7d72721e7504e12d50204f7d9e9d9fe60d9c6a4fd18ad629604729df4f7f3867199b62885623fab68a02863e7877955ca4a56c867157a559722b7b350b668a0b" @@ -1795,16 +1794,6 @@ txWitnessSetfc863a44 = -- Helpers -newTxBody : TransactionBody -newTxBody = - Tx.newBody - - -newTxWitnessSet : WitnessSet -newTxWitnessSet = - Tx.newWitnessSet - - {-| Convert the internal representation of Natural, using a base 2^26, back into a Natural. -} bigNat : List Int -> Natural diff --git a/tests/Cardano/TransactionTests2.elm b/tests/Cardano/TransactionTests2.elm index 69811a9..b5eeba3 100644 --- a/tests/Cardano/TransactionTests2.elm +++ b/tests/Cardano/TransactionTests2.elm @@ -6,10 +6,9 @@ import Cardano.Address as Address exposing (Credential(..), NetworkId(..)) import Cardano.Data as Data exposing (Data(..)) import Cardano.Redeemer exposing (RedeemerTag(..)) import Cardano.Script exposing (NativeScript(..)) -import Cardano.Transaction as Transaction exposing (Nonce(..), TransactionBody, WitnessSet, noParamUpdate) +import Cardano.Transaction as Transaction exposing (Nonce(..), TransactionBody, WitnessSet, newBody, newWitnessSet, noParamUpdate) import Cardano.Transaction.AuxiliaryData exposing (AuxiliaryData) import Cardano.Transaction.AuxiliaryData.Metadatum as Metadatum -import Cardano.Transaction.Builder as Tx import Cardano.Utxo as Utxo exposing (DatumOption(..)) import Cardano.Value as Value import Cbor.Decode as D @@ -77,7 +76,7 @@ auxiliaryData8a8f8dfe = body8a8f8dfe : TransactionBody body8a8f8dfe = - { newTxBody + { newBody | auxiliaryDataHash = Just (Bytes.fromStringUnchecked "36663d429bded43331a968fcaa3a0aba03d6d83474176b8c85a019b0b408ff8d") , fee = Just (N.fromSafeInt 203781) , inputs = @@ -114,7 +113,7 @@ body8a8f8dfe = witnessSet8a8f8dfe : WitnessSet witnessSet8a8f8dfe = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "6ee6dfafc7fdcd553bf0c11cc93d165c77a93a265af250eafb1dca2b044ae0b62d6eb4969e7946c438be5f73b0d9a25ad83d074c8d9cd6f4c80ace7b7c62ab0d" @@ -152,7 +151,7 @@ decodebf095309 = bodybf095309 : TransactionBody bodybf095309 = - { newTxBody + { newBody | fee = Just (N.fromSafeInt 211613) , inputs = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "03b02cff29a5f2dfc827e00345eaab8b29a3d740e9878aa6e5dd2b52da0763c5" } ] , outputs = @@ -218,7 +217,7 @@ bodybf095309 = witnessSetbf095309 : WitnessSet witnessSetbf095309 = - { newTxWitnessSet + { newWitnessSet | vkeywitness = Just [ { signature = Bytes.fromStringUnchecked "c65d631ecb286668eeef3537c279fb0c5c5d54bb7ab71a6d0c795f48f6093e664f9e923fd590e3373dd9e054eb622724cb107673a83ad201f503622cdcdae603", vkey = Bytes.fromStringUnchecked "61261a95b7613ee6bf2067dad77b70349729b0c50d57bc1cf30de0db4a1e73a8" } @@ -309,7 +308,7 @@ auxiliaryData9c91bdbb = body9c91bdbb : TransactionBody body9c91bdbb = - { newTxBody + { newBody | auxiliaryDataHash = Just (Bytes.fromStringUnchecked "91ebd602815a977fff9028bbebbe7bfb7f8ae703c65a684e5c85f380f5249e24") , collateral = [ { outputIndex = 0, transactionId = Bytes.fromStringUnchecked "f6e81bb9da6b4d635f3d774c7b7a58813a47b899bb52fef34caa4250fa8aa261" } ] , fee = Just (N.fromSafeInt 228509) @@ -336,7 +335,7 @@ body9c91bdbb = witnessSet9c91bdbb : WitnessSet witnessSet9c91bdbb = - { newTxWitnessSet + { newWitnessSet | plutusData = Just [ Data.Constr (N.fromSafeInt 0) @@ -401,16 +400,6 @@ decodeOutputfd83f4f9 = -- Helpers -newTxBody : TransactionBody -newTxBody = - Tx.newBody - - -newTxWitnessSet : WitnessSet -newTxWitnessSet = - Tx.newWitnessSet - - {-| Convert the internal representation of Natural, using a base 2^26, back into a Natural. -} bigNat : List Int -> Natural diff --git a/tests/Cardano/TxBuilding.elm b/tests/Cardano/TxBuilding.elm new file mode 100644 index 0000000..386ccb3 --- /dev/null +++ b/tests/Cardano/TxBuilding.elm @@ -0,0 +1,614 @@ +module Cardano.TxBuilding exposing (suite) + +import Bytes.Comparable as Bytes exposing (Bytes) +import Bytes.Map as Map +import Cardano exposing (Fee(..), ScriptWitness(..), SpendSource(..), TxFinalizationError(..), TxIntent(..), TxOtherInfo(..), WitnessSource(..), finalize) +import Cardano.Address as Address exposing (Address, Credential(..), NetworkId(..), StakeCredential(..)) +import Cardano.CoinSelection as CoinSelection exposing (Error(..)) +import Cardano.MultiAsset as MultiAsset exposing (MultiAsset) +import Cardano.Script as Script +import Cardano.Transaction as Transaction exposing (Transaction, newBody, newWitnessSet) +import Cardano.Transaction.AuxiliaryData.Metadatum as Metadatum exposing (Metadatum) +import Cardano.Utxo as Utxo exposing (Output, OutputReference) +import Cardano.Value as Value exposing (Value) +import Expect exposing (Expectation) +import Integer +import Natural exposing (Natural) +import Test exposing (Test, describe, test) + + +suite : Test +suite = + describe "Cardano Tx building" + [ okTxBuilding + , failTxBuilding + ] + + +okTxBuilding : Test +okTxBuilding = + describe "Successfull" + [ okTxTest "with just manual fees" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 2 ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = [] + } + (\_ -> + { newTx + | body = + { newBody + | fee = Just (ada 2) + , inputs = [ makeRef "0" 0 ] + } + , witnessSet = + { newWitnessSet + | vkeywitness = Just [ { vkey = dummyBytes 32, signature = dummyBytes 64 } ] + } + } + ) + , okTxTest "with just auto fees" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 2 ] + , fee = autoFee + , txOtherInfo = [] + , txIntents = [] + } + (\tx -> + let + feeAmount = + Transaction.computeFees tx + + adaLeft = + Natural.sub (ada 2) feeAmount + in + { newTx + | body = + { newBody + | fee = Just feeAmount + , inputs = [ makeRef "0" 0 ] + , outputs = [ Utxo.fromLovelace testAddr.me adaLeft ] + } + , witnessSet = + { newWitnessSet + | vkeywitness = Just [ { vkey = dummyBytes 32, signature = dummyBytes 64 } ] + } + } + ) + , okTxTest "with spending from, and sending to the same address" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 5 ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + [ Spend <| From testAddr.me (Value.onlyLovelace <| ada 1) + , SendTo testAddr.me (Value.onlyLovelace <| ada 1) + ] + } + (\_ -> + { newTx + | body = + { newBody + | fee = Just (ada 2) + , inputs = [ makeRef "0" 0 ] + , outputs = [ Utxo.fromLovelace testAddr.me (ada 3) ] + } + , witnessSet = + { newWitnessSet + | vkeywitness = Just [ { vkey = dummyBytes 32, signature = dummyBytes 64 } ] + } + } + ) + , okTxTest "send 1 ada from me to you" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 5 ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + [ Spend <| From testAddr.me (Value.onlyLovelace <| ada 1) + , SendTo testAddr.you (Value.onlyLovelace <| ada 1) + ] + } + (\_ -> + { newTx + | body = + { newBody + | fee = Just (ada 2) + , inputs = [ makeRef "0" 0 ] + , outputs = + [ Utxo.fromLovelace testAddr.you (ada 1) + , Utxo.fromLovelace testAddr.me (ada 2) + ] + } + , witnessSet = + { newWitnessSet + | vkeywitness = Just [ { vkey = dummyBytes 32, signature = dummyBytes 64 } ] + } + } + ) + , okTxTest "I pay the fees for your ada transfer to me" + { localStateUtxos = + [ makeAdaOutput 0 testAddr.me 5 + , makeAdaOutput 1 testAddr.you 7 + ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + [ Spend <| From testAddr.you (Value.onlyLovelace <| ada 1) + , SendTo testAddr.me (Value.onlyLovelace <| ada 1) + ] + } + (\_ -> + { newTx + | body = + { newBody + | fee = Just (ada 2) + , inputs = [ makeRef "0" 0, makeRef "1" 1 ] + , outputs = + [ Utxo.fromLovelace testAddr.you (ada 6) + , Utxo.fromLovelace testAddr.me (ada 4) + ] + } + , witnessSet = + { newWitnessSet + | vkeywitness = + Just + -- Two keys since I pay the fee, and spend your utxo + [ { vkey = dummyBytes 32, signature = dummyBytes 64 } + , { vkey = dummyBytes 32, signature = dummyBytes 64 } + ] + } + } + ) + , let + threeCat = + Value.onlyToken cat.policyId cat.assetName Natural.three + + threeCatOneAda = + { threeCat | lovelace = ada 1 } + in + okTxTest "send 3 cat with 1 ada from me to you" + { localStateUtxos = + [ ( makeRef "0" 0, Utxo.fromLovelace testAddr.me (ada 5) ) + , ( makeRef "1" 1, Utxo.simpleOutput testAddr.me threeCat ) + ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + [ Spend <| From testAddr.me threeCatOneAda + , SendTo testAddr.you threeCatOneAda + ] + } + (\_ -> + { newTx + | body = + { newBody + | fee = Just (ada 2) + , inputs = [ makeRef "0" 0, makeRef "1" 1 ] + , outputs = + [ Utxo.simpleOutput testAddr.you threeCatOneAda + , Utxo.fromLovelace testAddr.me (ada 2) + ] + } + , witnessSet = + { newWitnessSet + | vkeywitness = Just [ { vkey = dummyBytes 32, signature = dummyBytes 64 } ] + } + } + ) + , let + threeCat = + Value.onlyToken cat.policyId cat.assetName Natural.three + + minAda = + Utxo.minAdaForAssets testAddr.you threeCat.assets + + threeCatMinAda = + { threeCat | lovelace = minAda } + in + okTxTest "send 3 cat with minAda from me to you" + { localStateUtxos = + [ ( makeRef "0" 0, Utxo.fromLovelace testAddr.me (ada 5) ) + , ( makeRef "1" 1, Utxo.simpleOutput testAddr.me threeCat ) + ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + [ Spend <| From testAddr.me threeCatMinAda + , SendTo testAddr.you threeCatMinAda + ] + } + (\_ -> + { newTx + | body = + { newBody + | fee = Just (ada 2) + , inputs = [ makeRef "0" 0, makeRef "1" 1 ] + , outputs = + [ Utxo.simpleOutput testAddr.you threeCatMinAda + , Utxo.fromLovelace testAddr.me (Natural.sub (ada 3) minAda) + ] + } + , witnessSet = + { newWitnessSet + | vkeywitness = Just [ { vkey = dummyBytes 32, signature = dummyBytes 64 } ] + } + } + ) + , okTxTest "mint 1 dog and burn 1 cat" + { localStateUtxos = + [ makeAdaOutput 0 testAddr.me 5 + , makeAsset 1 testAddr.me cat.policyIdStr cat.assetNameStr 3 + , ( dog.scriptRef, dog.refOutput ) + , ( cat.scriptRef, cat.refOutput ) + ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + -- minting 1 dog + [ MintBurn + { policyId = dog.policyId + , assets = Map.singleton dog.assetName Integer.one + , scriptWitness = NativeWitness (WitnessReference dog.scriptRef) + } + , SendTo testAddr.me (Value.onlyToken dog.policyId dog.assetName Natural.one) + + -- burning 1 cat + , Spend <| From testAddr.me (Value.onlyToken cat.policyId cat.assetName Natural.one) + , MintBurn + { policyId = cat.policyId + , assets = Map.singleton cat.assetName Integer.negativeOne + , scriptWitness = NativeWitness (WitnessReference cat.scriptRef) + } + ] + } + (\_ -> + { newTx + | body = + { newBody + | fee = Just (ada 2) + , inputs = [ makeRef "0" 0, makeRef "1" 1 ] + , referenceInputs = [ cat.scriptRef, dog.scriptRef ] + , mint = + MultiAsset.mintAdd + (MultiAsset.onlyToken dog.policyId dog.assetName Integer.one) + (MultiAsset.onlyToken cat.policyId cat.assetName Integer.negativeOne) + , outputs = + [ { address = testAddr.me + , amount = + Value.onlyLovelace (ada 3) + -- 1 minted dog + |> Value.add (Value.onlyToken dog.policyId dog.assetName Natural.one) + -- 2 cat left after burning 1 from the utxo with 3 cat + |> Value.add (Value.onlyToken cat.policyId cat.assetName Natural.two) + , datumOption = Nothing + , referenceScript = Nothing + } + ] + } + , witnessSet = + { newWitnessSet + | vkeywitness = Just [ { vkey = dummyBytes 32, signature = dummyBytes 64 } ] + } + } + ) + + -- TODO: test with plutus script spending + ] + + +okTxTest : + String + -> + { localStateUtxos : List ( OutputReference, Output ) + , fee : Fee + , txOtherInfo : List TxOtherInfo + , txIntents : List TxIntent + } + -> (Transaction -> Transaction) + -> Test +okTxTest description { localStateUtxos, fee, txOtherInfo, txIntents } expectTransaction = + test description <| + \_ -> + let + buildingConfig = + { localStateUtxos = Utxo.refDictFromList localStateUtxos -- 2 ada at my address + , coinSelectionAlgo = CoinSelection.largestFirst + } + in + case finalize buildingConfig fee txOtherInfo txIntents of + Err error -> + Expect.fail (Debug.toString error) + + Ok tx -> + Expect.equal tx <| expectTransaction tx + + +failTxBuilding : Test +failTxBuilding = + describe "Detected failure" + [ failTxTest "when there is no utxo in local state" + { localStateUtxos = [] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = [] + } + (\error -> + case error of + FailedToPerformCoinSelection (UTxOBalanceInsufficient _) -> + Expect.pass + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + , failTxTest "when there is insufficient manual fee (0.1 ada here)" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 5 ] + , fee = ManualFee [ { paymentSource = testAddr.me, exactFeeAmount = Natural.fromSafeInt 100000 } ] + , txOtherInfo = [] + , txIntents = [] + } + (\error -> + case error of + InsufficientManualFee _ -> + Expect.pass + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + , failTxTest "when inputs are missing from local state" + { localStateUtxos = [] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + [ Spend <| FromWalletUtxo (makeRef "0" 0) + , SendTo testAddr.me (Value.onlyLovelace <| ada 1) + ] + } + (\error -> + case error of + ReferenceOutputsMissingFromLocalState [ ref ] -> + Expect.equal ref (makeRef "0" 0) + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + , failTxTest "when Tx intents are unbalanced (too much spend here)" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 5 ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = [ Spend <| From testAddr.me (Value.onlyLovelace <| ada 1) ] + } + (\error -> + case error of + UnbalancedIntents _ -> + Expect.pass + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + , failTxTest "when Tx intents are unbalanced (too much send here)" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 5 ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = [ SendTo testAddr.me (Value.onlyLovelace <| ada 1) ] + } + (\error -> + case error of + UnbalancedIntents _ -> + Expect.pass + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + , failTxTest "when there is not enough minAda in created output (100 lovelaces here)" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 5 ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + [ Spend <| From testAddr.me (Value.onlyLovelace <| Natural.fromSafeInt 100) + , SendToOutput (\_ -> Utxo.fromLovelace testAddr.me <| Natural.fromSafeInt 100) + ] + } + (\error -> + case error of + NotEnoughMinAda _ -> + Expect.pass + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + , failTxTest "when we send CNT without Ada" + { localStateUtxos = + [ makeAdaOutput 0 testAddr.me 5 + , makeAsset 1 testAddr.me cat.policyIdStr cat.assetNameStr 3 + ] + , fee = twoAdaFee + , txOtherInfo = [] + , txIntents = + [ Spend <| From testAddr.me (Value.onlyToken cat.policyId cat.assetName Natural.three) + , SendTo testAddr.you (Value.onlyToken cat.policyId cat.assetName Natural.three) + ] + } + (\error -> + case error of + NotEnoughMinAda _ -> + Expect.pass + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + , failTxTest "when there are duplicated metadata tags (tag 0 here)" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 5 ] + , fee = twoAdaFee + , txOtherInfo = + [ TxMetadata { tag = Natural.zero, metadata = Metadatum.Int Integer.one } + , TxMetadata { tag = Natural.zero, metadata = Metadatum.Int Integer.two } + ] + , txIntents = [] + } + (\error -> + case error of + DuplicatedMetadataTags 0 -> + Expect.pass + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + , failTxTest "when validity range is incorrect (start > end)" + { localStateUtxos = [ makeAdaOutput 0 testAddr.me 5 ] + , fee = twoAdaFee + , txOtherInfo = [ TxTimeValidityRange { start = 1, end = Natural.zero } ] + , txIntents = [] + } + (\error -> + case error of + IncorrectTimeValidityRange _ -> + Expect.pass + + _ -> + Expect.fail ("I didn’t expect this failure: " ++ Debug.toString error) + ) + + -- TODO: test for collateral selection error + ] + + +failTxTest : + String + -> + { localStateUtxos : List ( OutputReference, Output ) + , fee : Fee + , txOtherInfo : List TxOtherInfo + , txIntents : List TxIntent + } + -> (TxFinalizationError -> Expectation) + -> Test +failTxTest description { localStateUtxos, fee, txOtherInfo, txIntents } expectedFailure = + test description <| + \_ -> + let + buildingConfig = + { localStateUtxos = Utxo.refDictFromList localStateUtxos -- 2 ada at my address + , coinSelectionAlgo = CoinSelection.largestFirst + } + in + case finalize buildingConfig fee txOtherInfo txIntents of + Err error -> + expectedFailure error + + Ok tx -> + Expect.fail "This Tx building was not supposed to succeed" + + +newTx = + Transaction.new + + + +-- Test data + + +testAddr = + { me = makeWalletAddress "me" + , you = makeWalletAddress "you" + } + + +dog = + { policyId = Bytes.fromText "dog" + , policyIdStr = "dog" + , assetName = Bytes.fromText "yksoh" + , assetNameStr = "yksoh" + , scriptRef = makeRef "dogScriptRef" 0 + , refOutput = + { address = makeAddress "dogScriptRefAddress" + , amount = Value.onlyLovelace (ada 5) + , datumOption = Nothing + , referenceScript = Just <| Script.Native <| Script.ScriptAll [] -- dummy + } + } + + +cat = + { policyId = Bytes.fromText "cat" + , policyIdStr = "cat" + , assetName = Bytes.fromText "felix" + , assetNameStr = "felix" + , scriptRef = makeRef "catScriptRef" 0 + , refOutput = + { address = makeAddress "catScriptRefAddress" + , amount = Value.onlyLovelace (ada 6) + , datumOption = Nothing + , referenceScript = Just <| Script.Native <| Script.ScriptAll [] -- dummy + } + } + + + +-- Fee + + +twoAdaFee = + ManualFee [ { paymentSource = testAddr.me, exactFeeAmount = ada 2 } ] + + +autoFee = + AutoFee { paymentSource = testAddr.me } + + + +-- Helper functions + + +makeWalletAddress : String -> Address +makeWalletAddress name = + Address.Shelley + { networkId = Mainnet + , paymentCredential = VKeyHash (Bytes.fromText name) + , stakeCredential = Just (InlineCredential (VKeyHash <| Bytes.fromText name)) + } + + +makeAddress : String -> Address +makeAddress name = + Bytes.fromText ("key:" ++ name) + |> Address.enterprise Mainnet + + +makeRef : String -> Int -> OutputReference +makeRef id index = + { transactionId = Bytes.fromText id + , outputIndex = index + } + + +makeAsset : Int -> Address -> String -> String -> Int -> ( OutputReference, Output ) +makeAsset index address policyId name amount = + ( makeRef (String.fromInt index) index + , { address = address + , amount = makeToken policyId name amount + , datumOption = Nothing + , referenceScript = Nothing + } + ) + + +makeAdaOutput : Int -> Address -> Int -> ( OutputReference, Output ) +makeAdaOutput index address amount = + ( makeRef (String.fromInt index) index + , Utxo.fromLovelace address (ada amount) + ) + + +makeToken : String -> String -> Int -> Value +makeToken policyId name amount = + Value.onlyToken (Bytes.fromText policyId) (Bytes.fromText name) (Natural.fromSafeInt amount) + + +ada : Int -> Natural +ada n = + Natural.fromSafeInt n + |> Natural.mul (Natural.fromSafeInt 1000000) + + +dummyBytes : Int -> Bytes a +dummyBytes bytesLength = + -- Helper function to create dummy bytes, mostly for fee estimation + Bytes.fromStringUnchecked (String.repeat (2 * bytesLength) "0")