diff --git a/CHANGELOG.md b/CHANGELOG.md index 1073b5c466a..7c682452375 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,7 +22,7 @@ changes. + Reference scripts on the layer 2 ledger are non-problematic. - Introduced a hard-coded limit of 100 ADA for the commit tx on mainnet: help people to not shoot themselves in the foot too hard. - - Added `ReachedMainnetHardcodedLimit` API error to signal that the hard-coded mainnet ADA limit is reached. + - Added `CommittedTooMuchADAForMainnet` API error to signal that the hard-coded mainnet ADA limit is exceeded. ## [0.9.0] - 2023-03-02 diff --git a/hydra-node/json-schemas/api.yaml b/hydra-node/json-schemas/api.yaml index 88aa5d39914..1fe4b407275 100644 --- a/hydra-node/json-schemas/api.yaml +++ b/hydra-node/json-schemas/api.yaml @@ -1139,17 +1139,23 @@ components: failureReason: type: string - - title: ReachedMainnetHardcodedLimit + - title: CommittedTooMuchADAForMainnet description: | Raised if the user tries to commit more than 100 ADA while on the mainnet network. type: object additionalProperties: false required: - tag + - userCommitted + - mainnetLimit properties: + userCommitted: + type: number + mainnetLimit: + type: number tag: type: string - enum: ["ReachedMainnetHardcodedLimit"] + enum: ["CommittedTooMuchADAForMainnet"] Signature: type: string diff --git a/hydra-node/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs index 16a9c0b4ad4..86f3c4e8c2f 100644 --- a/hydra-node/src/Hydra/Chain.hs +++ b/hydra-node/src/Hydra/Chain.hs @@ -30,6 +30,10 @@ import Hydra.Snapshot (ConfirmedSnapshot, SnapshotNumber) import Test.QuickCheck (vectorOf) import Test.QuickCheck.Instances.Time () +-- | Hardcoded limit for commit tx on mainnet +maxMainnetLovelace :: Integer +maxMainnetLovelace = 100_000_000 + -- | Contains the head's parameters as established in the initial transaction. data HeadParameters = HeadParameters { contestationPeriod :: ContestationPeriod @@ -132,8 +136,9 @@ data PostTxError tx -- NOTE: PlutusDebugInfo does not have much available instances so we put it -- in Text form but it's lame PlutusValidationFailed {plutusFailure :: Text, plutusDebugInfo :: Text} - | -- | User tried to commit more than 100 ADA hardcoded limit on mainnet - ReachedMainnetHardcodedLimit + | -- | User tried to commit more than 'maxMainnetLovelace' hardcoded limit on mainnet + -- we keep track of both the hardcoded limit and what the user originally tried to commit + CommittedTooMuchADAForMainnet {userCommitted :: Integer, mainnetLimit :: Integer} deriving (Generic) deriving instance (IsTx tx, IsChainState tx) => Eq (PostTxError tx) diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs index 86ff3f17b4c..204bb416b9d 100644 --- a/hydra-node/src/Hydra/Chain/Direct/State.hs +++ b/hydra-node/src/Hydra/Chain/Direct/State.hs @@ -22,6 +22,7 @@ import Hydra.Cardano.Api ( CtxUTxO, Hash, Key (SigningKey, VerificationKey, verificationKeyHash), + Lovelace (..), NetworkId (Mainnet, Testnet), NetworkMagic (NetworkMagic), PaymentKey, @@ -57,6 +58,7 @@ import Hydra.Chain ( IsChainState (..), OnChainTx (..), PostTxError (..), + maxMainnetLovelace, ) import Hydra.Chain.Direct.ScriptRegistry ( ScriptRegistry (..), @@ -310,7 +312,7 @@ commit ctx st utxo = do [aUTxO] -> do rejectByronAddress aUTxO rejectReferenceScripts aUTxO - rejectMoreThan100ADA networkId (snd aUTxO) + rejectMoreThanMainnetLimit networkId (snd aUTxO) Right $ commitTx networkId scriptRegistry headId ownParty (Just aUTxO) initial [] -> do Right $ commitTx networkId scriptRegistry headId ownParty Nothing initial @@ -354,13 +356,14 @@ commit ctx st utxo = do ReferenceScriptNone -> Right () ReferenceScript{} -> Left CannotCommitReferenceScript + -- Rejects outputs with more than 'maxMainnetLovelace' lovelace on mainnet -- NOTE: Remove this limit once we have more experiments on mainnet. - rejectMoreThan100ADA :: NetworkId -> TxOut CtxUTxO -> Either (PostTxError Tx) () - rejectMoreThan100ADA Mainnet output = - if selectLovelace (txOutValue output) > 100_000_000 - then Left $ ReachedMainnetHardcodedLimit - else return () - rejectMoreThan100ADA _network _txOut = return () + rejectMoreThanMainnetLimit :: NetworkId -> TxOut CtxUTxO -> Either (PostTxError Tx) () + rejectMoreThanMainnetLimit network output = + when (network == Mainnet && lovelaceAmt > maxMainnetLovelace) $ + Left $ CommittedTooMuchADAForMainnet lovelaceAmt maxMainnetLovelace + where + Lovelace lovelaceAmt = selectLovelace (txOutValue output) -- | Construct a collect transaction based on the 'InitialState'. This will -- reimburse all the already committed outputs. diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs index 085132a0ecc..486d5bc597d 100644 --- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs @@ -22,7 +22,7 @@ import Hydra.Cardano.Api ( UTxO, hashScript, lovelaceToValue, - mkVkAddress, + modifyTxOutValue, renderUTxO, scriptPolicyId, toPlutusCurrencySymbol, @@ -34,7 +34,7 @@ import Hydra.Cardano.Api ( pattern PlutusScriptSerialised, ) import Hydra.Cardano.Api.Pretty (renderTx) -import Hydra.Chain (OnChainTx (..), PostTxError (..)) +import Hydra.Chain (OnChainTx (..), PostTxError (..), maxMainnetLovelace) import Hydra.Chain.Direct.Contract.Mutation ( Mutation (ChangeMintingPolicy, ChangeOutput, Changes), applyMutation, @@ -86,6 +86,7 @@ import Hydra.ContestationPeriod (toNominalDiffTime) import Hydra.Ledger.Cardano ( genOutput, genTxIn, + genTxOut, genTxOutAdaOnly, genTxOutByron, genTxOutWithReferenceScript, @@ -116,10 +117,10 @@ import Test.QuickCheck ( forAll, forAllBlind, forAllShow, + getPositive, label, sized, sublistOf, - suchThat, tabulate, (.||.), (=/=), @@ -246,10 +247,19 @@ spec = parallel $ do Left CannotCommitReferenceScript{} -> property True _ -> property False - prop "reject Commits with more than 100 ADA" $ - forAllCommitWithMoreThan100ADA $ \case - ReachedMainnetHardcodedLimit -> property True - _ -> property False + prop "reject Commits with more than maxMainnetLovelace Lovelace" $ + monadicST $ do + hctx <- pickBlind $ genHydraContext maximumNumberOfParties + (ctx, stInitial) <- pickBlind $ genStInitial hctx + utxo <- pickBlind $ genAdaOnlyUTxOOnMainnetWithAmountBiggerThanOutLimit + let mainnetChainContext = ctx{networkId = Mainnet} + pure $ + case commit mainnetChainContext stInitial utxo of + Left CommittedTooMuchADAForMainnet{userCommitted, mainnetLimit} -> + -- check that user committed more than our limit but also use 'maxMainnetLovelace' + -- to be sure we didn't construct 'CommittedTooMuchADAForMainnet' wrongly + property $ userCommitted > mainnetLimit && userCommitted > maxMainnetLovelace + _ -> property False describe "abort" $ do propBelowSizeLimit maxTxSize forAllAbort @@ -290,6 +300,17 @@ spec = parallel $ do it "can close & fanout every collected head" $ do prop_canCloseFanoutEveryCollect +genAdaOnlyUTxOOnMainnetWithAmountBiggerThanOutLimit :: Gen UTxO +genAdaOnlyUTxOOnMainnetWithAmountBiggerThanOutLimit = do + adaAmount <- (+ maxMainnetLovelace) . getPositive <$> arbitrary + utxo <- genUTxO1 genTxOut + let utxoPairs = + ( \(a, b) -> + (a, modifyTxOutValue (const $ lovelaceToValue (Lovelace adaAmount)) b) + ) + <$> UTxO.pairs utxo + pure . UTxO.UTxO $ Map.fromList utxoPairs + -- * Properties prop_canCloseFanoutEveryCollect :: Property @@ -415,29 +436,6 @@ forAllCommit' action = do "Non-empty commit" & counterexample ("tx: " <> renderTx tx) -forAllCommitWithMoreThan100ADA :: - (PostTxError Tx -> Property) -> - Property -forAllCommitWithMoreThan100ADA action = do - forAll (genHydraContext maximumNumberOfParties) $ \hctx -> - forAll (genStInitial hctx) $ \(ctx, stInitial) -> - forAll genAdaOnlyUTxOOnMainnetWithAmountBiggerThan100k $ \utxo -> - case commit (alterChainContextNetworkToMainnet ctx) stInitial utxo of - Right{} -> property False - Left e -> action e - where - genAdaOnlyUTxOOnMainnetWithAmountBiggerThan100k :: Gen UTxO - genAdaOnlyUTxOOnMainnetWithAmountBiggerThan100k = do - vk <- arbitrary - adaAmount <- arbitrary `suchThat` (> 0) - let value = lovelaceToValue $ Lovelace (adaAmount + 100_000_000) - txIn <- arbitrary - pure . UTxO.UTxO $ - Map.singleton txIn (TxOut (mkVkAddress Mainnet vk) value TxOutDatumNone ReferenceScriptNone) - - alterChainContextNetworkToMainnet ctx = - ctx{networkId = Mainnet} - forAllAbort :: (Testable property) => (UTxO -> Tx -> property) ->