From a29f2f3dca87b62700b059b38d07cd7db9e0b2f4 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 15 Mar 2023 16:16:22 +0100 Subject: [PATCH] Allow multiple commits This changes the Redeemer and Datum types of commitTx to be [TxOutRef] instead of Maybe TxOutRef and generalize the checks on- and off-chain to work on a list of committed UTxO instead of an optional, single one. --- hydra-node/src/Hydra/Chain/Direct/State.hs | 51 +++++++++++---------- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 52 ++++++++++------------ hydra-plutus/src/Hydra/Contract/Commit.hs | 2 +- hydra-plutus/src/Hydra/Contract/Head.hs | 39 +++++----------- hydra-plutus/src/Hydra/Contract/Initial.hs | 47 ++++++++++--------- 5 files changed, 87 insertions(+), 104 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs index 60e252a6553..3f1eec87fd0 100644 --- a/hydra-node/src/Hydra/Chain/Direct/State.hs +++ b/hydra-node/src/Hydra/Chain/Direct/State.hs @@ -307,17 +307,11 @@ commit ctx st utxo = do case ownInitial of Nothing -> Left (CannotFindOwnInitial{knownUTxO = getKnownUTxO st}) - Just initial -> - case UTxO.pairs utxo of - [aUTxO] -> do - rejectByronAddress aUTxO - rejectReferenceScripts aUTxO - rejectMoreThanMainnetLimit networkId (snd aUTxO) - Right $ commitTx networkId scriptRegistry headId ownParty (Just aUTxO) initial - [] -> do - Right $ commitTx networkId scriptRegistry headId ownParty Nothing initial - _ -> - Left (MoreThanOneUTxOCommitted @Tx) + Just initial -> do + rejectByronAddress utxo + rejectReferenceScripts utxo + rejectMoreThanMainnetLimit networkId utxo + Right $ commitTx networkId scriptRegistry headId ownParty utxo initial where ChainContext{networkId, ownParty, ownVerificationKey, scriptRegistry} = ctx @@ -343,28 +337,33 @@ commit ctx st utxo = do [(AssetName bs, 1)] -> bs == serialiseToRawBytes vkh _ -> False - rejectByronAddress :: (TxIn, TxOut CtxUTxO) -> Either (PostTxError Tx) () - rejectByronAddress = \case - (_, TxOut (ByronAddressInEra addr) _ _ _) -> - Left (UnsupportedLegacyOutput addr) - (_, TxOut ShelleyAddressInEra{} _ _ _) -> - Right () - - rejectReferenceScripts :: (TxIn, TxOut CtxUTxO) -> Either (PostTxError Tx) () - rejectReferenceScripts (_, out) = - case txOutReferenceScript out of - ReferenceScriptNone -> Right () - ReferenceScript{} -> Left CannotCommitReferenceScript + rejectByronAddress :: UTxO -> Either (PostTxError Tx) () + rejectByronAddress u = do + forM_ u $ \case + (TxOut (ByronAddressInEra addr) _ _ _) -> + Left (UnsupportedLegacyOutput addr) + (TxOut ShelleyAddressInEra{} _ _ _) -> + Right () + + rejectReferenceScripts :: UTxO -> Either (PostTxError Tx) () + rejectReferenceScripts u = + when (any hasReferenceScript u) $ + Left CannotCommitReferenceScript + where + hasReferenceScript out = + case txOutReferenceScript out of + ReferenceScript{} -> True + ReferenceScriptNone -> False -- Rejects outputs with more than 'maxMainnetLovelace' lovelace on mainnet -- NOTE: Remove this limit once we have more experiments on mainnet. - rejectMoreThanMainnetLimit :: NetworkId -> TxOut CtxUTxO -> Either (PostTxError Tx) () - rejectMoreThanMainnetLimit network output = + rejectMoreThanMainnetLimit :: NetworkId -> UTxO -> Either (PostTxError Tx) () + rejectMoreThanMainnetLimit network u = do when (network == Mainnet && lovelaceAmt > maxMainnetLovelace) $ Left $ CommittedTooMuchADAForMainnet lovelaceAmt maxMainnetLovelace where - lovelaceAmt = selectLovelace (txOutValue output) + lovelaceAmt = foldMap (selectLovelace . txOutValue) u -- | Construct a collect transaction based on the 'InitialState'. This will -- reimburse all the already committed outputs. diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index a51c0ab73c6..b6dbb9cca70 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -170,9 +170,8 @@ commitTx :: ScriptRegistry -> HeadId -> Party -> - -- | A single UTxO to commit to the Head - -- We currently limit committing one UTxO to the head because of size limitations. - Maybe (TxIn, TxOut CtxUTxO) -> + -- | The UTxO to commit to the Head + UTxO -> -- | The initial output (sent to each party) which should contain the PT and is -- locked by initial script (TxIn, TxOut CtxUTxO, Hash PaymentKey) -> @@ -182,7 +181,7 @@ commitTx networkId scriptRegistry headId party utxo (initialInput, out, vkh) = emptyTxBody & addInputs [(initialInput, initialWitness)] & addReferenceInputs [initialScriptRef] - & addVkInputs (maybeToList mCommittedInput) + & addVkInputs committedTxIns & addExtraRequiredSigners [vkh] & addOutputs [commitOutput] where @@ -198,9 +197,9 @@ commitTx networkId scriptRegistry headId party utxo (initialInput, out, vkh) = mkScriptDatum $ Initial.datum (headIdToCurrencySymbol headId) initialRedeemer = toScriptData . Initial.redeemer $ - Initial.ViaCommit (toPlutusTxOutRef <$> mCommittedInput) - mCommittedInput = - fst <$> utxo + Initial.ViaCommit (toPlutusTxOutRef <$> committedTxIns) + committedTxIns = + Set.toList $ UTxO.inputSet utxo commitOutput = TxOut commitAddress commitValue commitDatum ReferenceScriptNone commitScript = @@ -208,19 +207,16 @@ commitTx networkId scriptRegistry headId party utxo (initialInput, out, vkh) = commitAddress = mkScriptAddress @PlutusScriptV2 networkId commitScript commitValue = - txOutValue out <> maybe mempty (txOutValue . snd) utxo + txOutValue out <> foldMap txOutValue utxo commitDatum = mkTxOutDatum $ mkCommitDatum party utxo (headIdToCurrencySymbol headId) -mkCommitDatum :: Party -> Maybe (TxIn, TxOut CtxUTxO) -> CurrencySymbol -> Plutus.Datum +mkCommitDatum :: Party -> UTxO -> CurrencySymbol -> Plutus.Datum mkCommitDatum party utxo headId = - Commit.datum (partyToChain party, serializedUTxO, headId) + Commit.datum (partyToChain party, commits, headId) where - serializedUTxO = case utxo of - Nothing -> - Nothing - Just (i, o) -> - Commit.serializeCommit (i, o) + commits = + mapMaybe Commit.serializeCommit $ UTxO.pairs utxo -- | Create a transaction collecting all "committed" utxo and opening a Head, -- i.e. driving the Head script state. @@ -274,14 +270,13 @@ collectComTx networkId scriptRegistry vk initialThreadOutput commits headId = , headId = headIdToCurrencySymbol headId } - extractCommit d = + extractCommits d = case fromScriptData d of Nothing -> error "SNAFU" - Just ((_, Just o, _) :: Commit.DatumType) -> Just o - _ -> Nothing + Just ((_, cs, _) :: Commit.DatumType) -> cs utxoHash = - Head.hashPreSerializedCommits $ mapMaybe (extractCommit . snd . snd) $ Map.toList commits + Head.hashPreSerializedCommits $ foldMap (extractCommits . snd . snd) $ Map.toList commits mkCommit (commitInput, (_commitOutput, commitDatum)) = ( commitInput @@ -774,22 +769,21 @@ observeCommitTx :: Maybe CommitObservation observeCommitTx networkId initials tx = do initialTxIn <- findInitialTxIn - mCommittedTxIn <- decodeInitialRedeemer initialTxIn + committedTxIns <- decodeInitialRedeemer initialTxIn (commitIn, commitOut) <- findTxOutByAddress commitAddress tx dat <- txOutScriptData commitOut - (onChainParty, onChainCommit, _headId) :: Commit.DatumType <- fromScriptData dat + (onChainParty, onChainCommits, _headId) :: Commit.DatumType <- fromScriptData dat party <- partyFromChain onChainParty - committed <- + committed <- do -- TODO: We could simplify this by just using the datum. However, we would -- need to ensure the commit is belonging to a head / is rightful. By just -- looking for some known initials we achieve this (a bit complicated) now. - case (mCommittedTxIn, onChainCommit >>= Commit.deserializeCommit (networkIdToNetwork networkId)) of - (Nothing, Nothing) -> Just mempty - (Just i, Just (_i, o)) -> Just $ UTxO.singleton (i, o) - (Nothing, Just{}) -> error "found commit with no redeemer out ref but with serialized output." - (Just{}, Nothing) -> error "found commit with redeemer out ref but with no serialized output." + committedUTxO <- traverse (Commit.deserializeCommit (networkIdToNetwork networkId)) onChainCommits + when (map fst committedUTxO /= committedTxIns) $ + error "TODO: commit redeemer not matching the serialized commits in commit datum" + pure . UTxO.fromPairs $ committedUTxO pure CommitObservation @@ -807,8 +801,8 @@ observeCommitTx networkId initials tx = do findRedeemerSpending tx >=> \case Initial.ViaAbort -> Nothing - Initial.ViaCommit{committedRef} -> - Just (fromPlutusTxOutRef <$> committedRef) + Initial.ViaCommit{committedRefs} -> + Just (fromPlutusTxOutRef <$> committedRefs) commitAddress = mkScriptAddress @PlutusScriptV2 networkId commitScript diff --git a/hydra-plutus/src/Hydra/Contract/Commit.hs b/hydra-plutus/src/Hydra/Contract/Commit.hs index 44ee6dc9233..cb5f51d0189 100644 --- a/hydra-plutus/src/Hydra/Contract/Commit.hs +++ b/hydra-plutus/src/Hydra/Contract/Commit.hs @@ -76,7 +76,7 @@ deserializeCommit network Commit{input, preSerializedOutput} = -- TODO: Party is not used on-chain but is needed off-chain while it's still -- based on mock crypto. When we move to real crypto we could simply use -- the PT's token name to identify the committing party -type DatumType = (Party, Maybe Commit, CurrencySymbol) +type DatumType = (Party, [Commit], CurrencySymbol) type RedeemerType = CommitRedeemer -- | The v_commit validator verifies that: diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index 3dd7118becb..20cca33cd52 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -114,31 +114,20 @@ checkAbort ctx@ScriptContext{scriptContextTxInfo = txInfo} headCurrencySymbol pa -- correspond to the number of commit inputs to make sure everything is -- reimbursed because we assume the outputs are correctly sorted with -- reimbursed commits coming first - hashTxOuts $ take (length commited) (txInfoOutputs txInfo) + hashTxOuts $ take (length committed) (txInfoOutputs txInfo) hashOfCommittedUTxO = - hashPreSerializedCommits commited + hashPreSerializedCommits committed - commited = committedUTxO [] (txInfoInputs txInfo) + committed = committedUTxO [] (txInfoInputs txInfo) committedUTxO commits = \case - [] -> - commits + [] -> commits TxInInfo{txInInfoResolved = txOut} : rest | hasPT headCurrencySymbol txOut -> - case commitDatum txInfo txOut of - Just commit -> - committedUTxO - (commit : commits) - rest - Nothing -> - committedUTxO - commits - rest + committedUTxO (commitDatum txInfo txOut <> commits) rest | otherwise -> - committedUTxO - commits - rest + committedUTxO commits rest -- | On-Chain verification for 'CollectCom' transition. It verifies that: -- @@ -222,11 +211,7 @@ checkCollectCom ctx@ScriptContext{scriptContextTxInfo = txInfo} (contestationPer | isHeadOutput txInInfoResolved = (commits, nCommits, notCollected) | hasPT headId txInInfoResolved = - case commitDatum txInfo txInInfoResolved of - Just commit@Commit{} -> - (commit : commits, succ nCommits, notCollected) - Nothing -> - (commits, succ nCommits, notCollected) + (commitDatum txInfo txInInfoResolved <> commits, succ nCommits, notCollected) | otherwise = (commits, nCommits, notCollected <> txOutValue txInInfoResolved) @@ -234,14 +219,14 @@ checkCollectCom ctx@ScriptContext{scriptContextTxInfo = txInfo} (contestationPer {-# INLINEABLE checkCollectCom #-} -- | Try to find the commit datum in the input and --- if it is there return the commited utxo -commitDatum :: TxInfo -> TxOut -> Maybe Commit +-- if it is there return the committed utxo +commitDatum :: TxInfo -> TxOut -> [Commit] commitDatum txInfo input = do let datum = findTxOutDatum txInfo input case fromBuiltinData @Commit.DatumType $ getDatum datum of - Just (_party, commit, _headId) -> - commit - Nothing -> Nothing + Just (_party, commits, _headId) -> + commits + Nothing -> [] {-# INLINEABLE commitDatum #-} -- | The close validator must verify that: diff --git a/hydra-plutus/src/Hydra/Contract/Initial.hs b/hydra-plutus/src/Hydra/Contract/Initial.hs index 99e342eb6b2..a5d1d05193c 100644 --- a/hydra-plutus/src/Hydra/Contract/Initial.hs +++ b/hydra-plutus/src/Hydra/Contract/Initial.hs @@ -34,7 +34,7 @@ import PlutusLedgerApi.V2 ( ScriptHash, ToData (toBuiltinData), TokenName (unTokenName), - TxInInfo (txInInfoResolved), + TxInInfo (..), TxOut (txOutValue), TxOutRef, Value (getValue), @@ -47,7 +47,7 @@ import qualified PlutusTx.Builtins as Builtins data InitialRedeemer = ViaAbort | ViaCommit - { committedRef :: Maybe TxOutRef + { committedRefs :: [TxOutRef] -- ^ Points to the committed Utxo. } @@ -80,18 +80,18 @@ validator commitValidator headId red context = traceIfFalse $(errorCode STNotBurned) (mustBurnST (txInfoMint $ scriptContextTxInfo context) headId) - ViaCommit{committedRef} -> - checkCommit commitValidator headId committedRef context + ViaCommit{committedRefs} -> + checkCommit commitValidator headId committedRefs context checkCommit :: -- | Hash of the commit validator ScriptHash -> -- | Head id CurrencySymbol -> - Maybe TxOutRef -> + [TxOutRef] -> ScriptContext -> Bool -checkCommit commitValidator headId committedRef context = +checkCommit commitValidator headId committedRefs context = checkCommittedValue && checkLockedCommit && checkHeadId @@ -103,17 +103,20 @@ checkCommit commitValidator headId committedRef context = lockedValue == initialValue + committedValue checkLockedCommit = - case (committedTxOut, lockedCommit) of - (Nothing, Nothing) -> + traceIfFalse $(errorCode MismatchCommittedTxOutInDatum) $ + go (committedUTxO, lockedCommits) + where + go = \case + ([], []) -> True - (Nothing, Just{}) -> + ([], (_ : _)) -> traceError $(errorCode NothingCommittedButTxOutInOutputDatum) - (Just{}, Nothing) -> + ((_ : _), []) -> traceError $(errorCode CommittedTxOutButNothingInOutputDatum) - (Just (ref, txOut), Just Commit{input, preSerializedOutput}) -> - traceIfFalse $(errorCode MismatchCommittedTxOutInDatum) $ - Builtins.serialiseData (toBuiltinData txOut) == preSerializedOutput - && ref == input + (TxInInfo{txInInfoOutRef, txInInfoResolved} : restCommitted, Commit{input, preSerializedOutput} : restCommits) -> + Builtins.serialiseData (toBuiltinData txInInfoResolved) == preSerializedOutput + && txInInfoOutRef == input + && go (restCommitted, restCommits) checkHeadId = traceIfFalse $(errorCode WrongHeadIdInCommitDatum) $ @@ -140,15 +143,17 @@ checkCommit commitValidator headId committedRef context = maybe mempty (txOutValue . txInInfoResolved) $ findOwnInput context committedValue = - maybe mempty (txOutValue . snd) committedTxOut + foldMap (txOutValue . txInInfoResolved) committedUTxO - committedTxOut = do - ref <- committedRef - (ref,) . txInInfoResolved <$> findTxInByTxOutRef ref txInfo + committedUTxO = do + flip fmap committedRefs $ \ref -> + case findTxInByTxOutRef ref txInfo of + Nothing -> traceError "outref not found" + Just txInInfo -> txInInfo lockedValue = valueLockedBy txInfo commitValidator - (lockedCommit, headId') = + (lockedCommits, headId') = case scriptOutputsAt commitValidator txInfo of [(dat, _)] -> case dat of @@ -160,8 +165,8 @@ checkCommit commitValidator headId committedRef context = Just da -> case fromBuiltinData @Commit.DatumType $ getDatum da of Nothing -> traceError $(errorCode ExpectedCommitDatumTypeGotSomethingElse) - Just (_party, mCommit, hid) -> - (mCommit, hid) + Just (_party, commits, hid) -> + (commits, hid) _ -> traceError $(errorCode ExpectedSingleCommitOutput) ScriptContext{scriptContextTxInfo = txInfo} = context