Address PR review comments

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
 

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

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)

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.

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) ->