Skip to content

Commit

Permalink
Add utxoToDecommit to FanoutTx
Browse files Browse the repository at this point in the history
This is needed to determine the proper hash of the outputs in the checkFanout
validator.
  • Loading branch information
v0d1ch committed May 15, 2024
1 parent d33cfa1 commit add7258
Show file tree
Hide file tree
Showing 10 changed files with 45 additions and 21 deletions.
4 changes: 2 additions & 2 deletions hydra-node/src/Hydra/Chain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@ data PostChainTx tx
}
| CloseTx {headId :: HeadId, headParameters :: HeadParameters, confirmedSnapshot :: ConfirmedSnapshot tx}
| ContestTx {headId :: HeadId, headParameters :: HeadParameters, confirmedSnapshot :: ConfirmedSnapshot tx}
| FanoutTx {utxo :: UTxOType tx, headSeed :: HeadSeed, contestationDeadline :: UTCTime}
| FanoutTx {utxo :: UTxOType tx, utxoToDecommit :: Maybe (UTxOType tx), headSeed :: HeadSeed, contestationDeadline :: UTCTime}
deriving stock (Generic)

deriving stock instance IsTx tx => Eq (PostChainTx tx)
Expand All @@ -93,7 +93,7 @@ instance IsTx tx => Arbitrary (PostChainTx tx) where
DecrementTx <$> shrink headId <*> shrink headParameters <*> shrink snapshot <*> shrink signatures
CloseTx{headId, headParameters, confirmedSnapshot} -> CloseTx <$> shrink headId <*> shrink headParameters <*> shrink confirmedSnapshot
ContestTx{headId, headParameters, confirmedSnapshot} -> ContestTx <$> shrink headId <*> shrink headParameters <*> shrink confirmedSnapshot
FanoutTx{utxo, headSeed, contestationDeadline} -> FanoutTx <$> shrink utxo <*> shrink headSeed <*> shrink contestationDeadline
FanoutTx{utxo, utxoToDecommit, headSeed, contestationDeadline} -> FanoutTx <$> shrink utxo <*> shrink utxoToDecommit <*> shrink headSeed <*> shrink contestationDeadline

-- | Describes transactions as seen on chain. Holds as minimal information as
-- possible to simplify observing the chain.
Expand Down
4 changes: 2 additions & 2 deletions hydra-node/src/Hydra/Chain/Direct/Handlers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -396,13 +396,13 @@ prepareTxToPost timeHandle wallet ctx spendableUTxO tx =
case contest ctx spendableUTxO headId contestationPeriod confirmedSnapshot upperBound of
Left _ -> throwIO (FailedToConstructContestTx @Tx)
Right contestTx -> pure contestTx
FanoutTx{utxo, headSeed, contestationDeadline} -> do
FanoutTx{utxo, utxoToDecommit, headSeed, contestationDeadline} -> do
deadlineSlot <- throwLeft $ slotFromUTCTime contestationDeadline
case headSeedToTxIn headSeed of
Nothing ->
throwIO (InvalidSeed{headSeed} :: PostTxError Tx)
Just seedTxIn ->
case fanout ctx spendableUTxO seedTxIn utxo deadlineSlot of
case fanout ctx spendableUTxO seedTxIn utxo utxoToDecommit deadlineSlot of
Left _ -> throwIO (FailedToConstructFanoutTx @Tx)
Right fanoutTx -> pure fanoutTx
where
Expand Down
17 changes: 11 additions & 6 deletions hydra-node/src/Hydra/Chain/Direct/State.hs
Original file line number Diff line number Diff line change
Expand Up @@ -598,19 +598,21 @@ fanout ::
UTxO ->
-- | Seed TxIn
TxIn ->
-- | Snapshot UTxO to fanout
-- | Snapshot UTxO to decommit to fanout
UTxO ->
-- | Snapshot UTxO to fanout
Maybe UTxO ->
-- | Contestation deadline as SlotNo, used to set lower tx validity bound.
SlotNo ->
Either FanoutTxError Tx
fanout ctx spendableUTxO seedTxIn utxo deadlineSlotNo = do
fanout ctx spendableUTxO seedTxIn utxo utxoToDecommit deadlineSlotNo = do
headUTxO <-
UTxO.find (isScriptTxOut headScript) (utxoOfThisHead (headPolicyId seedTxIn) spendableUTxO)
?> CannotFindHeadOutputToFanout

closedThreadUTxO <- checkHeadDatum headUTxO

pure $ fanoutTx scriptRegistry utxo closedThreadUTxO deadlineSlotNo headTokenScript
pure $ fanoutTx scriptRegistry utxo utxoToDecommit closedThreadUTxO deadlineSlotNo headTokenScript
where
headTokenScript = mkHeadTokenScript seedTxIn

Expand Down Expand Up @@ -1084,7 +1086,8 @@ genFanoutTx numParties numOutputs = do
cctx <- pickChainContext ctx
let deadlineSlotNo = slotNoFromUTCTime systemStart slotLength (getContestationDeadline stClosed)
spendableUTxO = getKnownUTxO stClosed
pure (ctx, stClosed, unsafeFanout cctx spendableUTxO seedTxIn toFanout deadlineSlotNo)
-- TODO: generate UTxO to decommit here too
pure (ctx, stClosed, unsafeFanout cctx spendableUTxO seedTxIn toFanout Nothing deadlineSlotNo)

getContestationDeadline :: ClosedState -> UTCTime
getContestationDeadline
Expand Down Expand Up @@ -1224,11 +1227,13 @@ unsafeFanout ::
TxIn ->
-- | Snapshot UTxO to fanout
UTxO ->
-- | Snapshot decommit UTxO to fanout
Maybe UTxO ->
-- | Contestation deadline as SlotNo, used to set lower tx validity bound.
SlotNo ->
Tx
unsafeFanout ctx spendableUTxO seedTxIn utxo deadlineSlotNo =
either (error . show) id $ fanout ctx spendableUTxO seedTxIn utxo deadlineSlotNo
unsafeFanout ctx spendableUTxO seedTxIn utxo utxoToDecommit deadlineSlotNo =
either (error . show) id $ fanout ctx spendableUTxO seedTxIn utxo utxoToDecommit deadlineSlotNo

unsafeObserveInit ::
HasCallStack =>
Expand Down
17 changes: 14 additions & 3 deletions hydra-node/src/Hydra/Chain/Direct/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -684,19 +684,21 @@ fanoutTx ::
ScriptRegistry ->
-- | Snapshotted UTxO to fanout on layer 1
UTxO ->
-- | Snapshotted decommit UTxO to fanout on layer 1
Maybe UTxO ->
-- | Everything needed to spend the Head state-machine output.
(TxIn, TxOut CtxUTxO) ->
-- | Contestation deadline as SlotNo, used to set lower tx validity bound.
SlotNo ->
-- | Minting Policy script, made from initial seed
PlutusScript ->
Tx
fanoutTx scriptRegistry utxo (headInput, headOutput) deadlineSlotNo headTokenScript =
fanoutTx scriptRegistry utxo utxoToDecommit (headInput, headOutput) deadlineSlotNo headTokenScript =
unsafeBuildTransaction $
emptyTxBody
& addInputs [(headInput, headWitness)]
& addReferenceInputs [headScriptRef]
& addOutputs orderedTxOutsToFanout
& addOutputs (orderedTxOutsToFanout <> orderedTxOutsToDecommit)
& burnTokens headTokenScript Burn headTokens
& setValidityLowerBound (deadlineSlotNo + 1)
& setTxMetadata (TxMetadataInEra $ mkHydraHeadV1TxName "FanoutTx")
Expand All @@ -710,14 +712,23 @@ fanoutTx scriptRegistry utxo (headInput, headOutput) deadlineSlotNo headTokenScr
headScript =
fromPlutusScript @PlutusScriptV2 Head.validatorScript
headRedeemer =
toScriptData (Head.Fanout $ fromIntegral $ length utxo)
toScriptData $
Head.Fanout
{ numberOfFanoutOutputs = fromIntegral $ length utxo
, numberOfDecommitOutputs = fromIntegral $ maybe 0 length utxoToDecommit
}

headTokens =
headTokensFromValue headTokenScript (txOutValue headOutput)

orderedTxOutsToFanout =
toTxContext <$> toList utxo

orderedTxOutsToDecommit =
case utxoToDecommit of
Nothing -> []
Just decommitUTxO -> toTxContext <$> toList decommitUTxO

data AbortTxError
= OverlappingInputs
| CannotFindHeadOutputToAbort
Expand Down
4 changes: 2 additions & 2 deletions hydra-node/src/Hydra/HeadLogic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -835,9 +835,9 @@ onClosedClientFanout ::
ClosedState tx ->
Outcome tx
onClosedClientFanout closedState =
cause OnChainEffect{postChainTx = FanoutTx{utxo, headSeed, contestationDeadline}}
cause OnChainEffect{postChainTx = FanoutTx{utxo, utxoToDecommit, headSeed, contestationDeadline}}
where
Snapshot{utxo} = getSnapshot confirmedSnapshot
Snapshot{utxo, utxoToDecommit} = getSnapshot confirmedSnapshot

ClosedState{headSeed, confirmedSnapshot, contestationDeadline} = closedState

Expand Down
2 changes: 2 additions & 0 deletions hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,8 @@ healthyFanoutTx =
fanoutTx
scriptRegistry
healthyFanoutUTxO
-- TODO: add something to decommit here
Nothing
(headInput, headOutput)
healthySlotNo
headTokenScript
Expand Down
2 changes: 1 addition & 1 deletion hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -445,7 +445,7 @@ prop_canCloseFanoutEveryCollect = monadicST $ do
_ -> fail "not observed close"
-- Fanout
let fanoutUTxO = getKnownUTxO stClosed
let txFanout = unsafeFanout cctx fanoutUTxO seedTxIn initialUTxO (slotNoFromUTCTime systemStart slotLength deadline)
let txFanout = unsafeFanout cctx fanoutUTxO seedTxIn initialUTxO Nothing (slotNoFromUTCTime systemStart slotLength deadline)

-- Properties
let collectFails =
Expand Down
2 changes: 2 additions & 0 deletions hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -568,6 +568,8 @@ newFanoutTx actor snapshot = do
spendableUTxO
Fixture.testSeedInput
(snapshotUTxO snapshot)
-- TODO: tackle decommit utxo
Nothing
deadline
where
CP.UnsafeContestationPeriod contestationPeriod = Fixture.cperiod
Expand Down
12 changes: 8 additions & 4 deletions hydra-plutus/src/Hydra/Contract/Head.hs
Original file line number Diff line number Diff line change
Expand Up @@ -79,8 +79,8 @@ headValidator oldState input ctx =
checkClose ctx parties initialUtxoHash signature contestationPeriod headId snapshotNumber
(Closed{parties, snapshotNumber = closedSnapshotNumber, contestationDeadline, contestationPeriod, headId, contesters}, Contest{signature}) ->
checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotNumber signature contesters headId
(Closed{parties, utxoHash, contestationDeadline, headId}, Fanout{numberOfFanoutOutputs}) ->
checkFanout utxoHash contestationDeadline numberOfFanoutOutputs ctx headId parties
(Closed{parties, utxoHash, utxoToDecommitHash, contestationDeadline, headId}, Fanout{numberOfFanoutOutputs, numberOfDecommitOutputs}) ->
checkFanout utxoHash utxoToDecommitHash contestationDeadline numberOfFanoutOutputs numberOfDecommitOutputs ctx headId parties
_ ->
traceError $(errorCode InvalidHeadStateTransition)

Expand Down Expand Up @@ -483,14 +483,16 @@ checkContest ctx contestationDeadline contestationPeriod parties closedSnapshotN
{-# INLINEABLE checkContest #-}

checkFanout ::
BuiltinByteString ->
BuiltinByteString ->
POSIXTime ->
Integer ->
Integer ->
ScriptContext ->
CurrencySymbol ->
[Party] ->
Bool
checkFanout utxoHash contestationDeadline numberOfFanoutOutputs ScriptContext{scriptContextTxInfo = txInfo} currencySymbol parties =
checkFanout utxoHash utxoToDecommitHash contestationDeadline numberOfFanoutOutputs numberOfDecommitOutputs ScriptContext{scriptContextTxInfo = txInfo} currencySymbol parties =
mustBurnAllHeadTokens minted currencySymbol parties
&& hasSameUTxOHash
&& afterContestationDeadline
Expand All @@ -499,10 +501,12 @@ checkFanout utxoHash contestationDeadline numberOfFanoutOutputs ScriptContext{sc

hasSameUTxOHash =
traceIfFalse $(errorCode FannedOutUtxoHashNotEqualToClosedUtxoHash) $
fannedOutUtxoHash == utxoHash
fannedOutUtxoHash == utxoHash && decommitUtxoHash == utxoToDecommitHash

fannedOutUtxoHash = hashTxOuts $ take numberOfFanoutOutputs txInfoOutputs

decommitUtxoHash = hashTxOuts $ take numberOfDecommitOutputs $ drop numberOfFanoutOutputs txInfoOutputs

TxInfo{txInfoOutputs} = txInfo

afterContestationDeadline =
Expand Down
2 changes: 1 addition & 1 deletion hydra-plutus/src/Hydra/Contract/HeadState.hs
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ data Input
{ signature :: [Signature]
}
| Abort
| Fanout {numberOfFanoutOutputs :: Integer}
| Fanout {numberOfFanoutOutputs :: Integer, numberOfDecommitOutputs :: Integer}
deriving stock (Generic, Show)

PlutusTx.unstableMakeIsData ''Input

0 comments on commit add7258

Please sign in to comment.