PR review changes

Signed-off-by: Sasha Bogicevic <[email protected]>

hydra-node/src/Hydra/HeadLogic.hs

@@ -323,9 +323,6 @@ onOpenNetworkReqTx env ledger st ttl tx =
     -- Spec: wait L̂ ◦ tx ≠ ⊥
     waitApplyTx $ \newLocalUTxO ->
       (cause (ClientEffect $ ServerOutput.TxValid headId tx) <>) $
-        -- Spec: T̂ ← T̂ ⋃ {tx}
-        --       L̂  ← L̂ ◦ tx
-
         -- Spec: T̂ ← T̂ ⋃ {tx}
         --       L̂  ← L̂ ◦ tx
         newState TransactionAppliedToLocalUTxO{tx, newLocalUTxO}
@@ -415,8 +412,6 @@ onOpenNetworkReqSn env ledger st otherParty sv sn requestedTxIds mDecommitTx =
   requireReqSn $
     -- Spec: wait ŝ = ̅S.s
     waitNoSnapshotInFlight $
-      -- Spec: wait v = v̂
-
       -- Spec: wait v = v̂
       waitOnSnapshotVersion $
         requireApplicableDecommitTx $ \(activeUTxO, mUtxoToDecommit) ->

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

@@ -50,23 +50,27 @@ data DepositRedeemer
 PlutusTx.unstableMakeIsData ''DepositRedeemer
 
 -- | Deposit datum containing HeadId, deadline and a list of deposits.
-type DepositDatum = (CurrencySymbol, POSIXTime, [Commit])
+newtype DepositDatum
+  = DepositDatum (CurrencySymbol, POSIXTime, [Commit])
+
+PlutusTx.unstableMakeIsData ''DepositDatum
 
 -- | v_deposit validator checks
 --
--- * Claim redeemer -> no checks are needed
+-- * Claim redeemer -> more checks will be added
 --
 -- * Recover redeemer
---     * The deadline HAS BEEN reached.
---     * The hash of locked outputs are mathing the tx outputs.
+--     * The deadline has been reached.
+--     * The hash of recovered outputs are matching the deposited outputs.
 validator :: DepositDatum -> DepositRedeemer -> ScriptContext -> Bool
-validator (_headId, dl, deposits) r ctx =
+validator depositDatum r ctx =
   case r of
-    Claim -> True
+    Claim -> False
     Recover m ->
       afterDeadline
         && recoverOutputs m
  where
+  DepositDatum (_headId, dl, deposits) = depositDatum
   recoverOutputs m =
     traceIfFalse $(errorCode IncorrectDepositHash) $
       hashOfOutputs m == hashPreSerializedCommits deposits

hydra-tx/exe/Main.hs

@@ -6,7 +6,7 @@ import Hydra.Prelude
 import Cardano.Api.UTxO (UTxO)
 import Cardano.Api.UTxO qualified as UTxO
 import Data.Aeson (eitherDecodeFileStrict)
-import Hydra.Contract.Deposit (DepositDatum)
+import Hydra.Contract.Deposit (DepositDatum (..))
 import Hydra.Tx.Deposit (depositTx)
 import Hydra.Tx.Recover (recoverTx)
 import Hydra.Tx.Utils (extractInlineDatumFromTxOut)
@@ -23,7 +23,7 @@ main = do
           let depositTransaction = depositTx networkId headId utxo depositDeadline
           writeFileLBS outFile $ textEnvelopeToJSON Nothing depositTransaction
           putStrLn $ "Wrote deposit transaction to " <> outFile
-    Recover RecoverOptions{networkId, headId, outFile, recoverTxIn, utxoFilePath, depositDeadline, recoverSlotNo} -> do
+    Recover RecoverOptions{networkId, outFile, recoverTxIn, utxoFilePath, recoverSlotNo} -> do
       eitherDecodeFileStrict utxoFilePath >>= \case
         Left err -> die $ "failed to parse provided UTXO file! " <> err
         Right (utxo :: UTxO) -> do
@@ -32,8 +32,8 @@ main = do
             Just depositedTxOut -> do
               case extractInlineDatumFromTxOut @DepositDatum depositedTxOut of
                 Nothing -> die "failed to extract DepositDatum from recover UTxO"
-                Just (_, _, depositted) -> do
+                Just (DepositDatum (headCS, datumDepositDeadline, deposited)) -> do
                   let recoverTransaction =
-                        recoverTx networkId headId recoverTxIn depositted depositDeadline recoverSlotNo
+                        recoverTx networkId headCS recoverTxIn deposited datumDepositDeadline recoverSlotNo
                   writeFileLBS outFile $ textEnvelopeToJSON Nothing recoverTransaction
                   putStrLn $ "Wrote deposit transaction to " <> outFile

hydra-tx/exe/Options.hs

@@ -27,10 +27,8 @@ data DepositOptions = DepositOptions
 data RecoverOptions = RecoverOptions
   { recoverTxIn :: TxIn
   , utxoFilePath :: FilePath
-  , headId :: HeadId
   , outFile :: FilePath
   , networkId :: NetworkId
-  , depositDeadline :: UTCTime
   , recoverSlotNo :: SlotNo
   }
   deriving stock (Show, Eq)
@@ -76,10 +74,8 @@ recoverOptionsParser =
   RecoverOptions
     <$> txInParser
     <*> utxoParser
-    <*> headIdParser
     <*> outputFileParser
     <*> networkIdParser
-    <*> deadlineParser
     <*> lowerBoundSlotParser
 
 txInParser :: Parser TxIn
@@ -192,6 +188,9 @@ lowerBoundSlotParser =
       <> help
         ( mconcat
             [ "Provide a starting slot for the recover transaction. "
+            , "This value could be obtained by querying the current slot number of the target network."
+            , "The slot needs to be after the deadline which was set in the deposit transaction "
+            , "in order for a recover transaction to be valid."
             ]
         )
 

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

@@ -34,14 +34,13 @@ depositTx networkId headId depositUTxO deadline =
 
   depositInputs = (,BuildTxWith $ KeyWitness KeyWitnessForSpending) <$> depositInputsList
 
-  depositValue = foldMap (txOutValue . snd) (UTxO.pairs depositUTxO)
+  depositValue = foldMap txOutValue depositUTxO
 
   depositScript = fromPlutusScript @PlutusScriptV2 Deposit.validatorScript
 
-  deposits =
-    mapMaybe Commit.serializeCommit $ UTxO.pairs depositUTxO
+  deposits = mapMaybe Commit.serializeCommit $ UTxO.pairs depositUTxO
 
-  depositPlutusDatum = Deposit.datum (headIdToCurrencySymbol headId, posixFromUTCTime deadline, deposits)
+  depositPlutusDatum = Deposit.datum $ Deposit.DepositDatum (headIdToCurrencySymbol headId, posixFromUTCTime deadline, deposits)
 
   depositDatum = mkTxOutDatumInline depositPlutusDatum
 

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

@@ -13,42 +13,39 @@ import Hydra.Ledger.Cardano.Builder (
   setValidityLowerBound,
   unsafeBuildTransaction,
  )
-import Hydra.Plutus.Extras (posixFromUTCTime)
-import Hydra.Tx (HeadId, headIdToCurrencySymbol)
+import PlutusLedgerApi.V2 (CurrencySymbol, POSIXTime)
 
 -- | Builds a recover transaction to recover locked funds from the v_deposit script.
 recoverTx ::
   NetworkId ->
-  HeadId ->
+  CurrencySymbol ->
   -- | Deposit input
   TxIn ->
   -- | Already Deposited funds
   [Commit.Commit] ->
   -- | Recover deadline
-  UTCTime ->
+  POSIXTime ->
   -- | Lower bound slot number
   SlotNo ->
   Tx
-recoverTx networkId headId depositedTxIn depositted deadline lowerBoundSlot =
+recoverTx networkId headId depositTxIn depositted deadline lowerBoundSlot =
   unsafeBuildTransaction $
     emptyTxBody
       & addInputs recoverInputs
-      & addOutputs deposittedOutputs
+      & addOutputs depositOutputs
       & setValidityLowerBound lowerBoundSlot
  where
-  recoverInputs = (,depositWitness) <$> [depositedTxIn]
+  recoverInputs = (,depositWitness) <$> [depositTxIn]
 
-  redeemer = Deposit.Recover $ fromIntegral $ length deposittedOutputs
+  redeemer = Deposit.Recover $ fromIntegral $ length depositOutputs
 
   depositWitness =
     BuildTxWith $
       ScriptWitness scriptWitnessInCtx $
         mkScriptWitness depositScript (mkScriptDatum constructedDatum) (toScriptData redeemer)
 
-  constructedDatum = (headIdToCurrencySymbol headId, posixFromUTCTime deadline, depositted)
+  constructedDatum = (headId, deadline, depositted)
 
-  deposittedOutputs =
-    let deposited = mapMaybe (Commit.deserializeCommit (networkIdToNetwork networkId)) depositted
-     in fmap (toTxContext . snd) deposited
+  depositOutputs = toTxContext . snd <$> mapMaybe (Commit.deserializeCommit (networkIdToNetwork networkId)) depositted
 
   depositScript = fromPlutusScript @PlutusScriptV2 Deposit.validatorScript

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

@@ -45,7 +45,7 @@ import Hydra.Tx.Contract.Decrement (genDecrementMutation, healthyDecrementTx)
 import Hydra.Tx.Contract.Deposit (healthyDepositTx)
 import Hydra.Tx.Contract.FanOut (genFanoutMutation, healthyFanoutTx)
 import Hydra.Tx.Contract.Init (genInitMutation, healthyInitTx)
-import Hydra.Tx.Contract.Recover (healthyRecoverTx)
+import Hydra.Tx.Contract.Recover (genRecoverMutation, healthyRecoverTx)
 import Hydra.Tx.Crypto (aggregate, sign, toPlutusSignatures)
 import PlutusLedgerApi.V2 (fromBuiltin, toBuiltin)
 import Test.Hydra.Tx.Fixture (testNetworkId)
@@ -120,6 +120,8 @@ spec = parallel $ do
   describe "Recover" $ do
     prop "is healthy" $
       propTransactionEvaluates healthyRecoverTx
+    prop "does not survive random adversarial mutations" $
+      propMutation healthyRecoverTx genRecoverMutation
   describe "CloseInitial" $ do
     prop "is healthy" $
       propTransactionEvaluates healthyCloseInitialTx

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

@@ -5,43 +5,104 @@ import Hydra.Prelude
 
 import Cardano.Api.UTxO qualified as UTxO
 import Data.Fixed (Milli)
+import Data.List qualified as List
 import Data.Maybe (fromJust)
-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
-import Hydra.Contract.Deposit (DepositDatum)
-import Hydra.Tx (mkHeadId)
+import Data.Time.Clock.POSIX qualified as POSIX
+import Hydra.Contract.Deposit (DepositDatum (..), DepositRedeemer (Recover))
+import Hydra.Contract.DepositError (DepositError (..))
+import Hydra.Contract.Error (toErrorCode)
+import Hydra.Ledger.Cardano.Evaluate (slotLength, systemStart)
+import Hydra.Ledger.Cardano.Time (slotNoToUTCTime)
+import Hydra.Plutus.Extras (posixFromUTCTime)
 import Hydra.Tx.Deposit (depositTx)
+import Hydra.Tx.HeadId (mkHeadId)
 import Hydra.Tx.Recover (recoverTx)
 import Hydra.Tx.Utils (extractInlineDatumFromTxOut)
+import PlutusLedgerApi.V2 (CurrencySymbol, POSIXTime)
 import Test.Hydra.Tx.Fixture (testNetworkId, testPolicyId)
-import Test.Hydra.Tx.Gen (genUTxOAdaOnlyOfSize)
+import Test.Hydra.Tx.Gen (genUTxOAdaOnlyOfSize, genValue)
+import Test.Hydra.Tx.Mutation
+  (Mutation (ChangeInput, ChangeOutput, ChangeValidityLowerBound), SomeMutation (..), modifyInlineDatum)
+import Test.QuickCheck (elements, oneof, suchThat)
 
 healthyRecoverTx :: (Tx, UTxO)
 healthyRecoverTx =
-  (tx, utxo)
+  (tx, lookupUTxO)
  where
   tx =
     recoverTx
       testNetworkId
-      headId
+      headCS
       depositTxIn
       deposits
-      deadline
+      recoverDeadline
       recoverSlotNo
 
-  headId = mkHeadId testPolicyId
+  DepositDatum (_, _, deposits) =
+    fromJust $ extractInlineDatumFromTxOut @DepositDatum depositTxOut
 
-  deadline = (posixSecondsToUTCTime . realToFrac <$> (arbitrary :: Gen Milli)) `generateWith` 42
+recoverSlotNo :: SlotNo
+recoverSlotNo = SlotNo $ arbitrary `generateWith` 42
 
-  recoverSlotNo = arbitrary `generateWith` 42
+recoverDeadline :: POSIXTime
+recoverDeadline = posixFromUTCTime depositDeadline
 
-  utxo = utxoFromTx $ depositTx testNetworkId headId depositUTxO deadline
+depositDeadline :: UTCTime
+depositDeadline =
+  slotNoToUTCTime systemStart slotLength (recoverSlotNo - SlotNo 1)
 
-  depositUTxO = genUTxOAdaOnlyOfSize 1 `generateWith` 42
+depositTransaction :: Tx
+depositTransaction =
+  depositTx testNetworkId (mkHeadId headPolicyId) utxoToDeposit depositDeadline
 
-  (depositTxIn, depositTxOut) =
-    case UTxO.pairs utxo of
-      [] -> error "empty UTxO"
-      [(depositTxIn', depositTxOut')] -> (depositTxIn', depositTxOut')
-      _ -> error "multiple UTxO entries"
+utxoToDeposit :: UTxO
+utxoToDeposit = genUTxOAdaOnlyOfSize 1 `generateWith` 42
 
-  (_, _, deposits) = fromJust $ extractInlineDatumFromTxOut @DepositDatum depositTxOut
+headCS :: CurrencySymbol
+headCS = toPlutusCurrencySymbol testPolicyId
+
+headPolicyId :: PolicyId
+headPolicyId =
+  case fromPlutusCurrencySymbol headCS of
+    Nothing -> error "failed to create headId from provided CurrencySymbol"
+    Just policyId -> policyId
+
+lookupUTxO :: UTxO
+lookupUTxO = utxoFromTx depositTransaction
+
+depositTxIn :: TxIn
+depositTxOut :: TxOut CtxUTxO
+(depositTxIn, depositTxOut) = List.head $ UTxO.pairs lookupUTxO
+
+data RecoverMutation
+  = -- | Move the deposit deadline further so that the recover lower bound is
+    -- not after the deadline
+    MutateDepositDeadline
+  | -- | Change the recover output so that the datum commit hash does not match
+    MutateRecoverOutput
+  | -- | Remove the lower bound from the recover transaction
+    RemoveTxValidityLowerBound
+  deriving stock (Generic, Show, Enum, Bounded)
+
+genRecoverMutation :: (Tx, UTxO) -> Gen SomeMutation
+genRecoverMutation (tx, utxo) =
+  oneof
+    [ SomeMutation (pure $ toErrorCode DepositDeadlineNotReached) MutateDepositDeadline <$> do
+        -- Could also use depositTxIn/Out directly but this way we can be sure that the depositTxIn/Out are in the UTxO
+        let (depositIn, depositOut@(TxOut addr val _ rscript)) = List.head $ UTxO.pairs (resolveInputsUTxO utxo tx)
+        let n = POSIX.posixSecondsToUTCTime $ realToFrac $ (arbitrary :: Gen Milli) `generateWith` 42
+        let datum =
+              txOutDatum $
+                flip modifyInlineDatum (toTxContext depositOut) $ \case
+                  DepositDatum (headCS', depositDatumDeadline, commits) ->
+                    DepositDatum (headCS', depositDatumDeadline + posixFromUTCTime n, commits)
+        let newOutput = toCtxUTxOTxOut $ TxOut addr val datum rscript
+        pure $ ChangeInput depositIn newOutput (Just $ toScriptData $ Recover 1)
+    , SomeMutation (pure $ toErrorCode IncorrectDepositHash) MutateRecoverOutput <$> do
+        let outs = txOuts' tx
+        (ix :: Int, out) <- elements (zip [0 ..] outs)
+        value' <- genValue `suchThat` (/= txOutValue out)
+        pure $ ChangeOutput (fromIntegral ix) (modifyTxOutValue (const value') out)
+    , SomeMutation (pure $ toErrorCode DepositNoLowerBoundDefined) RemoveTxValidityLowerBound . ChangeValidityLowerBound <$> do
+        pure TxValidityNoLowerBound
+    ]