Skip to content

Commit 7dff751

Browse files
v0d1chv0d1ch
committed
PR Review changes
1 parent e774ec2 commit 7dff751

File tree

14 files changed

+84
-92
lines changed

14 files changed

+84
-92
lines changed

‎flake.lock

Lines changed: 20 additions & 20 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎flake.nix

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@
2424
nix-npm-buildpackage.url = "github:serokell/nix-npm-buildpackage";
2525

2626

27-
mithril.url = "github:input-output-hk/mithril/2445.0";
27+
mithril.url = "github:input-output-hk/mithril/2450.0";
2828
mithril-unstable.url = "github:input-output-hk/mithril/unstable";
2929
};
3030

‎hydra-cluster/src/Hydra/Cluster/Faucet.hs

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -151,15 +151,6 @@ createOutputAtAddress node@RunningNode{networkId, nodeSocket} atAddress datum va
151151
utxo <- findFaucetUTxO node 0
152152
let collateralTxIns = mempty
153153
let output = TxOut atAddress val datum ReferenceScriptNone
154-
-- let output =
155-
-- -- TODO: improve this so we don't autobalance and then reset the value
156-
-- modifyTxOutValue (const val) $
157-
-- mkTxOutAutoBalance
158-
-- pparams
159-
-- atAddress
160-
-- val
161-
-- datum
162-
-- ReferenceScriptNone
163154
buildTransaction
164155
networkId
165156
nodeSocket

‎hydra-node/src/Hydra/Chain/Direct/State.hs

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -111,7 +111,7 @@ import Hydra.Tx.ContestationPeriod qualified as ContestationPeriod
111111
import Hydra.Tx.Crypto (HydraKey)
112112
import Hydra.Tx.Decrement (decrementTx)
113113
import Hydra.Tx.Deposit (DepositObservation (..), depositTx, observeDepositTx, observeDepositTxOut)
114-
import Hydra.Tx.Fanout (fanoutTx)
114+
import Hydra.Tx.Fanout (IncrementalAction (..), fanoutTx)
115115
import Hydra.Tx.Increment (incrementTx)
116116
import Hydra.Tx.Init (initTx)
117117
import Hydra.Tx.OnChainId (OnChainId)
@@ -722,6 +722,7 @@ data FanoutTxError
722722
| MissingHeadDatumInFanout
723723
| WrongDatumInFanout
724724
| FailedToConvertFromScriptDataInFanout
725+
| BothCommitAndDecommitInFanout
725726
deriving stock (Show)
726727

727728
-- | Construct a fanout transaction based on the 'ClosedState' and off-chain
@@ -745,11 +746,18 @@ fanout ctx spendableUTxO seedTxIn utxo utxoToCommit utxoToDecommit deadlineSlotN
745746
headUTxO <-
746747
UTxO.find (isScriptTxOut headScript) (utxoOfThisHead (headPolicyId seedTxIn) spendableUTxO)
747748
?> CannotFindHeadOutputToFanout
748-
749749
closedThreadUTxO <- checkHeadDatum headUTxO
750-
751-
pure $ fanoutTx scriptRegistry utxo utxoToCommit utxoToDecommit closedThreadUTxO deadlineSlotNo headTokenScript
750+
incrementalAction <- setIncrementalAction ?> BothCommitAndDecommitInFanout
751+
pure $ fanoutTx scriptRegistry utxo incrementalAction closedThreadUTxO deadlineSlotNo headTokenScript
752752
where
753+
setIncrementalAction =
754+
case (utxoToCommit, utxoToDecommit) of
755+
(Just _, Just _) -> Nothing
756+
(Just _, Nothing) ->
757+
ToCommit <$> utxoToCommit
758+
(Nothing, Just _) -> ToDecommit <$> utxoToDecommit
759+
(Nothing, Nothing) -> Just NoThing
760+
753761
headTokenScript = mkHeadTokenScript seedTxIn
754762

755763
ChainContext{scriptRegistry} = ctx

‎hydra-node/src/Hydra/Chain/Direct/Tx.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -364,6 +364,7 @@ observeIncrementTx utxo tx = do
364364
(headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript
365365
(TxIn depositTxId _, depositOutput) <- findTxOutByScript @PlutusScriptV3 utxo depositScript
366366
dat <- txOutScriptData $ toTxContext depositOutput
367+
-- we need to be able to decode the datum, no need to use it tho
367368
_ :: Deposit.DepositDatum <- fromScriptData dat
368369
redeemer <- findRedeemerSpending tx headInput
369370
oldHeadDatum <- txOutScriptData $ toTxContext headOutput

‎hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs

Lines changed: 10 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -119,8 +119,7 @@ coversInterestingActions (Actions_ _ (Smart _ steps)) p =
119119
& cover 5 (closeNonInitial steps) "close with non initial snapshots"
120120
& cover 10 (hasFanout steps) "reach fanout"
121121
& cover 10 (fanoutWithSomeUTxO steps) "fanout with some UTxO"
122-
& cover 10 (fanoutWithCommitDelta steps) "fanout with additional commit UTxO to distribute"
123-
& cover 1 (fanoutWithDecommitDelta steps) "fanout with additional decommit UTxO to distribute"
122+
& cover 10 (fanoutWithCommitOrDecommitDelta steps) "fanout with additional de/commit UTxO to distribute"
124123
where
125124
hasSomeSnapshots =
126125
any $
@@ -146,20 +145,12 @@ coversInterestingActions (Actions_ _ (Smart _ steps)) p =
146145
&& not (null utxo)
147146
_ -> False
148147

149-
fanoutWithCommitDelta =
148+
fanoutWithCommitOrDecommitDelta =
150149
any $
151150
\(_ := ActionWithPolarity{polarAction, polarity}) -> case polarAction of
152-
Fanout{alphaUTxO} ->
151+
Fanout{alphaUTxO, omegaUTxO} ->
153152
polarity == PosPolarity
154-
&& not (null alphaUTxO)
155-
_ -> False
156-
157-
fanoutWithDecommitDelta =
158-
any $
159-
\(_ := ActionWithPolarity{polarAction, polarity}) -> case polarAction of
160-
Fanout{omegaUTxO} ->
161-
polarity == PosPolarity
162-
&& not (null omegaUTxO)
153+
&& (not (null alphaUTxO) || not (null omegaUTxO))
163154
_ -> False
164155

165156
countContests =
@@ -201,7 +192,7 @@ prop_runActions actions =
201192
coversInterestingActions actions
202193
. monadic runAppMProperty
203194
$ do
204-
print actions
195+
-- print actions
205196
void (runActions actions)
206197
where
207198
runAppMProperty :: AppM Property -> Property
@@ -368,7 +359,7 @@ instance StateModel Model where
368359
( 5
369360
, do
370361
-- Fanout with the currently known model state.
371-
omegaUTxO <- frequency [(1, pure pendingDecommit), (1, pure mempty), (1, arbitrary)]
362+
omegaUTxO <- frequency [(1, pure pendingDecommit), (1, pure mempty), (5, arbitrary)]
372363
alphaUTxO' <- frequency [(1, if null pendingDeposit then arbitrary else elements pendingDeposit), (1, arbitrary)]
373364
pure $
374365
Some $
@@ -483,8 +474,9 @@ instance StateModel Model where
483474
&& snapshot.number > closedSnapshotNumber
484475
&& snapshot.number > currentSnapshotNumber
485476
&& actor `notElem` alreadyContested
486-
Fanout{} ->
487-
headState == Closed
477+
Fanout{alphaUTxO, omegaUTxO} ->
478+
(alphaUTxO == mempty || omegaUTxO == mempty)
479+
&& headState == Closed
488480

489481
-- Determine actions we want to perform and want to see failing. If this is
490482
-- False, the action is discarded (e.g. it's invalid or we don't want to see
@@ -542,7 +534,7 @@ instance StateModel Model where
542534
NewSnapshot{newSnapshot} ->
543535
m
544536
{ knownSnapshots = nub $ newSnapshot : m.knownSnapshots
545-
, pendingDecommit = newSnapshot.toDecommit -- <> pendingDecommit
537+
, pendingDecommit = newSnapshot.toDecommit
546538
, currentSnapshotNumber = newSnapshot.number
547539
}
548540
Deposit{utxoToDeposit} ->

‎hydra-plutus/src/Hydra/Contract/Head.hs

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -415,8 +415,7 @@ checkClose ctx openBefore redeemer =
415415
ClosedDatum
416416
{ snapshotNumber = snapshotNumber'
417417
, utxoHash = utxoHash'
418-
, -- , alphaUTxOHash = alphaUTxOHash'
419-
omegaUTxOHash = omegaUTxOHash'
418+
, omegaUTxOHash = omegaUTxOHash'
420419
, parties = parties'
421420
, contestationDeadline = deadline
422421
, contestationPeriod = cperiod'
@@ -534,10 +533,11 @@ checkContest ctx closedDatum redeemer =
534533
case redeemer of
535534
ContestCurrent{signature} ->
536535
traceIfFalse $(errorCode FailedContestCurrent) $
537-
verifySnapshotSignature
538-
parties
539-
(headId, version, snapshotNumber', utxoHash', emptyHash, omegaUTxOHash')
540-
signature
536+
omegaUTxOHash' == emptyHash
537+
&& verifySnapshotSignature
538+
parties
539+
(headId, version, snapshotNumber', utxoHash', emptyHash, emptyHash)
540+
signature
541541
ContestUsedDec{signature, alreadyDecommittedUTxOHash} ->
542542
traceIfFalse $(errorCode FailedContestUsedDec) $
543543
omegaUTxOHash' == emptyHash
@@ -598,8 +598,7 @@ checkContest ctx closedDatum redeemer =
598598
ClosedDatum
599599
{ snapshotNumber = snapshotNumber'
600600
, utxoHash = utxoHash'
601-
, -- , alphaUTxOHash = alphaUTxOHash'
602-
omegaUTxOHash = omegaUTxOHash'
601+
, omegaUTxOHash = omegaUTxOHash'
603602
, parties = parties'
604603
, contestationDeadline = contestationDeadline'
605604
, contestationPeriod = contestationPeriod'

‎hydra-plutus/src/Hydra/Contract/HeadState.hs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -181,10 +181,9 @@ data Input
181181
| Abort
182182
| Fanout
183183
{ numberOfFanoutOutputs :: Integer
184-
, numberOfCommitOutputs :: Integer
185-
-- ^ TODO: add this to the spec
186-
, -- \^ Spec: m
187-
numberOfDecommitOutputs :: Integer
184+
, -- TODO: add this to the spec
185+
numberOfCommitOutputs :: Integer
186+
, numberOfDecommitOutputs :: Integer
188187
-- ^ Spec: n
189188
}
190189
deriving stock (Generic, Show)

‎hydra-tx/src/Hydra/Tx/Deposit.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,5 @@
11
module Hydra.Tx.Deposit where
22

3-
-- FIXME: delete this module once we are happy with the alternative aiken implementation
4-
53
import Hydra.Prelude
64

75
import Cardano.Api.UTxO qualified as UTxO

‎hydra-tx/src/Hydra/Tx/Fanout.hs

Lines changed: 12 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,8 @@ import Hydra.Ledger.Cardano.Builder (
1818
import Hydra.Tx.ScriptRegistry (ScriptRegistry (..))
1919
import Hydra.Tx.Utils (headTokensFromValue, mkHydraHeadV1TxName)
2020

21+
data IncrementalAction = ToCommit UTxO | ToDecommit UTxO | NoThing deriving (Eq, Show)
22+
2123
-- | Create the fanout transaction, which distributes the closed state
2224
-- accordingly. The head validator allows fanout only > deadline, so we need
2325
-- to set the lower bound to be deadline + 1 slot.
@@ -26,18 +28,16 @@ fanoutTx ::
2628
ScriptRegistry ->
2729
-- | Snapshotted UTxO to fanout on layer 1
2830
UTxO ->
29-
-- | Snapshotted commit UTxO to fanout on layer 1
30-
Maybe UTxO ->
31-
-- | Snapshotted decommit UTxO to fanout on layer 1
32-
Maybe UTxO ->
31+
-- | Snapshotted de/commit UTxO to fanout on layer 1
32+
IncrementalAction ->
3333
-- | Everything needed to spend the Head state-machine output.
3434
(TxIn, TxOut CtxUTxO) ->
3535
-- | Contestation deadline as SlotNo, used to set lower tx validity bound.
3636
SlotNo ->
3737
-- | Minting Policy script, made from initial seed
3838
PlutusScript ->
3939
Tx
40-
fanoutTx scriptRegistry utxo utxoToCommit utxoToDecommit (headInput, headOutput) deadlineSlotNo headTokenScript =
40+
fanoutTx scriptRegistry utxo incrementalAction (headInput, headOutput) deadlineSlotNo headTokenScript =
4141
unsafeBuildTransaction $
4242
emptyTxBody
4343
& addInputs [(headInput, headWitness)]
@@ -60,8 +60,8 @@ fanoutTx scriptRegistry utxo utxoToCommit utxoToDecommit (headInput, headOutput)
6060
Head.Fanout
6161
{ numberOfFanoutOutputs = fromIntegral $ length $ toList utxo
6262
, -- TODO: Update the spec with this new field 'numberOfCommitOutputs'
63-
numberOfCommitOutputs = fromIntegral $ length $ maybe [] toList utxoToCommit
64-
, numberOfDecommitOutputs = fromIntegral $ length (maybe [] toList utxoToDecommit)
63+
numberOfCommitOutputs = fromIntegral $ length orderedTxOutsToCommit
64+
, numberOfDecommitOutputs = fromIntegral $ length orderedTxOutsToDecommit
6565
}
6666

6767
headTokens =
@@ -70,12 +70,8 @@ fanoutTx scriptRegistry utxo utxoToCommit utxoToDecommit (headInput, headOutput)
7070
orderedTxOutsToFanout =
7171
toTxContext <$> toList utxo
7272

73-
orderedTxOutsToDecommit =
74-
case utxoToDecommit of
75-
Nothing -> []
76-
Just decommitUTxO -> toTxContext <$> toList decommitUTxO
77-
78-
orderedTxOutsToCommit =
79-
case utxoToCommit of
80-
Nothing -> []
81-
Just commitUTxO -> toTxContext <$> toList commitUTxO
73+
(orderedTxOutsToCommit, orderedTxOutsToDecommit) =
74+
case incrementalAction of
75+
ToCommit utxoToCommit -> (toTxContext <$> toList utxoToCommit, [])
76+
ToDecommit utxoToDecommit -> ([], toTxContext <$> toList utxoToDecommit)
77+
NoThing -> ([], [])

‎hydra-tx/test/Hydra/Tx/Contract/ContractSpec.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -149,6 +149,7 @@ spec = parallel $ do
149149
propTransactionEvaluates healthyContestTx
150150
prop "does not survive random adversarial mutations" $
151151
propMutation healthyContestTx genContestMutation
152+
-- TODO: Add CloseAny and ContestCurrent examples too
152153
describe "ContestDec" $ do
153154
prop "is healthy" $
154155
propTransactionEvaluates healthyContestTx

0 commit comments

Comments
 (0)