PR Review changes

flake.nix

@@ -24,7 +24,7 @@
     nix-npm-buildpackage.url = "github:serokell/nix-npm-buildpackage";
 
 
-    mithril.url = "github:input-output-hk/mithril/2445.0";
+    mithril.url = "github:input-output-hk/mithril/2450.0";
     mithril-unstable.url = "github:input-output-hk/mithril/unstable";
   };
 

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

@@ -151,15 +151,6 @@ createOutputAtAddress node@RunningNode{networkId, nodeSocket} atAddress datum va
   utxo <- findFaucetUTxO node 0
   let collateralTxIns = mempty
   let output = TxOut atAddress val datum ReferenceScriptNone
-  -- let output =
-  --       -- TODO: improve this so we don't autobalance and then reset the value
-  --       modifyTxOutValue (const val) $
-  --         mkTxOutAutoBalance
-  --           pparams
-  --           atAddress
-  --           val
-  --           datum
-  --           ReferenceScriptNone
   buildTransaction
     networkId
     nodeSocket

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

@@ -111,7 +111,7 @@ import Hydra.Tx.ContestationPeriod qualified as ContestationPeriod
 import Hydra.Tx.Crypto (HydraKey)
 import Hydra.Tx.Decrement (decrementTx)
 import Hydra.Tx.Deposit (DepositObservation (..), depositTx, observeDepositTx, observeDepositTxOut)
-import Hydra.Tx.Fanout (fanoutTx)
+import Hydra.Tx.Fanout (IncrementalAction (..), fanoutTx)
 import Hydra.Tx.Increment (incrementTx)
 import Hydra.Tx.Init (initTx)
 import Hydra.Tx.OnChainId (OnChainId)
@@ -722,6 +722,7 @@ data FanoutTxError
   | MissingHeadDatumInFanout
   | WrongDatumInFanout
   | FailedToConvertFromScriptDataInFanout
+  | BothCommitAndDecommitInFanout
   deriving stock (Show)
 
 -- | Construct a fanout transaction based on the 'ClosedState' and off-chain
@@ -745,11 +746,18 @@ fanout ctx spendableUTxO seedTxIn utxo utxoToCommit utxoToDecommit deadlineSlotN
   headUTxO <-
     UTxO.find (isScriptTxOut headScript) (utxoOfThisHead (headPolicyId seedTxIn) spendableUTxO)
       ?> CannotFindHeadOutputToFanout
-
   closedThreadUTxO <- checkHeadDatum headUTxO
-
-  pure $ fanoutTx scriptRegistry utxo utxoToCommit utxoToDecommit closedThreadUTxO deadlineSlotNo headTokenScript
+  incrementalAction <- setIncrementalAction ?> BothCommitAndDecommitInFanout
+  pure $ fanoutTx scriptRegistry utxo incrementalAction closedThreadUTxO deadlineSlotNo headTokenScript
  where
+  setIncrementalAction =
+    case (utxoToCommit, utxoToDecommit) of
+      (Just _, Just _) -> Nothing
+      (Just _, Nothing) ->
+        ToCommit <$> utxoToCommit
+      (Nothing, Just _) -> ToDecommit <$> utxoToDecommit
+      (Nothing, Nothing) -> Just NoThing
+
   headTokenScript = mkHeadTokenScript seedTxIn
 
   ChainContext{scriptRegistry} = ctx

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

@@ -364,6 +364,7 @@ observeIncrementTx utxo tx = do
   (headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript
   (TxIn depositTxId _, depositOutput) <- findTxOutByScript @PlutusScriptV3 utxo depositScript
   dat <- txOutScriptData $ toTxContext depositOutput
+  -- we need to be able to decode the datum, no need to use it tho
   _ :: Deposit.DepositDatum <- fromScriptData dat
   redeemer <- findRedeemerSpending tx headInput
   oldHeadDatum <- txOutScriptData $ toTxContext headOutput

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

@@ -119,8 +119,7 @@ coversInterestingActions (Actions_ _ (Smart _ steps)) p =
     & cover 5 (closeNonInitial steps) "close with non initial snapshots"
     & cover 10 (hasFanout steps) "reach fanout"
     & cover 10 (fanoutWithSomeUTxO steps) "fanout with some UTxO"
-    & cover 10 (fanoutWithCommitDelta steps) "fanout with additional commit UTxO to distribute"
-    & cover 1 (fanoutWithDecommitDelta steps) "fanout with additional decommit UTxO to distribute"
+    & cover 10 (fanoutWithCommitOrDecommitDelta steps) "fanout with additional de/commit UTxO to distribute"
  where
   hasSomeSnapshots =
     any $
@@ -146,20 +145,12 @@ coversInterestingActions (Actions_ _ (Smart _ steps)) p =
             && not (null utxo)
         _ -> False
 
-  fanoutWithCommitDelta =
+  fanoutWithCommitOrDecommitDelta =
     any $
       \(_ := ActionWithPolarity{polarAction, polarity}) -> case polarAction of
-        Fanout{alphaUTxO} ->
+        Fanout{alphaUTxO, omegaUTxO} ->
           polarity == PosPolarity
-            && not (null alphaUTxO)
-        _ -> False
-
-  fanoutWithDecommitDelta =
-    any $
-      \(_ := ActionWithPolarity{polarAction, polarity}) -> case polarAction of
-        Fanout{omegaUTxO} ->
-          polarity == PosPolarity
-            && not (null omegaUTxO)
+            && (not (null alphaUTxO) || not (null omegaUTxO))
         _ -> False
 
   countContests =
@@ -201,7 +192,7 @@ prop_runActions actions =
   coversInterestingActions actions
     . monadic runAppMProperty
     $ do
-      print actions
+      -- print actions
       void (runActions actions)
  where
   runAppMProperty :: AppM Property -> Property
@@ -368,7 +359,7 @@ instance StateModel Model where
           ( 5
           , do
               -- Fanout with the currently known model state.
-              omegaUTxO <- frequency [(1, pure pendingDecommit), (1, pure mempty), (1, arbitrary)]
+              omegaUTxO <- frequency [(1, pure pendingDecommit), (1, pure mempty), (5, arbitrary)]
               alphaUTxO' <- frequency [(1, if null pendingDeposit then arbitrary else elements pendingDeposit), (1, arbitrary)]
               pure $
                 Some $
@@ -483,8 +474,9 @@ instance StateModel Model where
         && snapshot.number > closedSnapshotNumber
         && snapshot.number > currentSnapshotNumber
         && actor `notElem` alreadyContested
-    Fanout{} ->
-      headState == Closed
+    Fanout{alphaUTxO, omegaUTxO} ->
+      (alphaUTxO == mempty || omegaUTxO == mempty)
+        && headState == Closed
 
   -- Determine actions we want to perform and want to see failing. If this is
   -- 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
       NewSnapshot{newSnapshot} ->
         m
           { knownSnapshots = nub $ newSnapshot : m.knownSnapshots
-          , pendingDecommit = newSnapshot.toDecommit -- <> pendingDecommit
+          , pendingDecommit = newSnapshot.toDecommit
           , currentSnapshotNumber = newSnapshot.number
           }
       Deposit{utxoToDeposit} ->

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

@@ -415,8 +415,7 @@ checkClose ctx openBefore redeemer =
   ClosedDatum
     { snapshotNumber = snapshotNumber'
     , utxoHash = utxoHash'
-    , -- , alphaUTxOHash = alphaUTxOHash'
-    omegaUTxOHash = omegaUTxOHash'
+    , omegaUTxOHash = omegaUTxOHash'
     , parties = parties'
     , contestationDeadline = deadline
     , contestationPeriod = cperiod'
@@ -534,10 +533,11 @@ checkContest ctx closedDatum redeemer =
     case redeemer of
       ContestCurrent{signature} ->
         traceIfFalse $(errorCode FailedContestCurrent) $
-          verifySnapshotSignature
-            parties
-            (headId, version, snapshotNumber', utxoHash', emptyHash, omegaUTxOHash')
-            signature
+          omegaUTxOHash' == emptyHash
+            && verifySnapshotSignature
+              parties
+              (headId, version, snapshotNumber', utxoHash', emptyHash, emptyHash)
+              signature
       ContestUsedDec{signature, alreadyDecommittedUTxOHash} ->
         traceIfFalse $(errorCode FailedContestUsedDec) $
           omegaUTxOHash' == emptyHash
@@ -598,8 +598,7 @@ checkContest ctx closedDatum redeemer =
   ClosedDatum
     { snapshotNumber = snapshotNumber'
     , utxoHash = utxoHash'
-    , -- , alphaUTxOHash = alphaUTxOHash'
-    omegaUTxOHash = omegaUTxOHash'
+    , omegaUTxOHash = omegaUTxOHash'
     , parties = parties'
     , contestationDeadline = contestationDeadline'
     , contestationPeriod = contestationPeriod'

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

@@ -181,10 +181,9 @@ data Input
   | Abort
   | Fanout
       { numberOfFanoutOutputs :: Integer
-      , numberOfCommitOutputs :: Integer
-      -- ^ TODO: add this to the spec
-      , -- \^ Spec: m
-        numberOfDecommitOutputs :: Integer
+      , -- TODO: add this to the spec
+        numberOfCommitOutputs :: Integer
+      , numberOfDecommitOutputs :: Integer
       -- ^ Spec: n
       }
   deriving stock (Generic, Show)

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

@@ -1,7 +1,5 @@
 module Hydra.Tx.Deposit where
 
--- FIXME: delete this module once we are happy with the alternative aiken implementation
-
 import Hydra.Prelude
 
 import Cardano.Api.UTxO qualified as UTxO

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

@@ -18,6 +18,8 @@ import Hydra.Ledger.Cardano.Builder (
 import Hydra.Tx.ScriptRegistry (ScriptRegistry (..))
 import Hydra.Tx.Utils (headTokensFromValue, mkHydraHeadV1TxName)
 
+data IncrementalAction = ToCommit UTxO | ToDecommit UTxO | NoThing deriving (Eq, Show)
+
 -- | Create the fanout transaction, which distributes the closed state
 -- accordingly. The head validator allows fanout only > deadline, so we need
 -- to set the lower bound to be deadline + 1 slot.
@@ -26,18 +28,16 @@ fanoutTx ::
   ScriptRegistry ->
   -- | Snapshotted UTxO to fanout on layer 1
   UTxO ->
-  -- | Snapshotted commit UTxO to fanout on layer 1
-  Maybe UTxO ->
-  -- | Snapshotted decommit UTxO to fanout on layer 1
-  Maybe UTxO ->
+  -- | Snapshotted de/commit UTxO to fanout on layer 1
+  IncrementalAction ->
   -- | 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 utxoToCommit utxoToDecommit (headInput, headOutput) deadlineSlotNo headTokenScript =
+fanoutTx scriptRegistry utxo incrementalAction (headInput, headOutput) deadlineSlotNo headTokenScript =
   unsafeBuildTransaction $
     emptyTxBody
       & addInputs [(headInput, headWitness)]
@@ -60,8 +60,8 @@ fanoutTx scriptRegistry utxo utxoToCommit utxoToDecommit (headInput, headOutput)
       Head.Fanout
         { numberOfFanoutOutputs = fromIntegral $ length $ toList utxo
         , -- TODO: Update the spec with this new field 'numberOfCommitOutputs'
-          numberOfCommitOutputs = fromIntegral $ length $ maybe [] toList utxoToCommit
-        , numberOfDecommitOutputs = fromIntegral $ length (maybe [] toList utxoToDecommit)
+          numberOfCommitOutputs = fromIntegral $ length orderedTxOutsToCommit
+        , numberOfDecommitOutputs = fromIntegral $ length orderedTxOutsToDecommit
         }
 
   headTokens =
@@ -70,12 +70,8 @@ fanoutTx scriptRegistry utxo utxoToCommit utxoToDecommit (headInput, headOutput)
   orderedTxOutsToFanout =
     toTxContext <$> toList utxo
 
-  orderedTxOutsToDecommit =
-    case utxoToDecommit of
-      Nothing -> []
-      Just decommitUTxO -> toTxContext <$> toList decommitUTxO
-
-  orderedTxOutsToCommit =
-    case utxoToCommit of
-      Nothing -> []
-      Just commitUTxO -> toTxContext <$> toList commitUTxO
+  (orderedTxOutsToCommit, orderedTxOutsToDecommit) =
+    case incrementalAction of
+      ToCommit utxoToCommit -> (toTxContext <$> toList utxoToCommit, [])
+      ToDecommit utxoToDecommit -> ([], toTxContext <$> toList utxoToDecommit)
+      NoThing -> ([], [])

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

@@ -149,6 +149,7 @@ spec = parallel $ do
       propTransactionEvaluates healthyContestTx
     prop "does not survive random adversarial mutations" $
       propMutation healthyContestTx genContestMutation
+  -- TODO: Add CloseAny and ContestCurrent examples too
   describe "ContestDec" $ do
     prop "is healthy" $
       propTransactionEvaluates healthyContestTx