Decrement on-chain: add checkSignatures

Note that this doesn't test thoroughly the signature verification
since we alter the redeemer signatures only, but it is a bit hard to
test this one since validator checks that run before this one are
ensuring valid signature. Next step is to enhance mutation framework
with the option to alter the input datum in such way to trigger the
signature checks.

hydra-node/src/Hydra/API/WSServer.hs

@@ -29,7 +29,6 @@ import Hydra.Chain (
  )
 import Hydra.Chain.Direct.State ()
 import Hydra.Ledger (UTxOType)
-import Hydra.Ledger.Cardano (Tx)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Options qualified as Options
 import Hydra.Party (Party)

hydra-node/test/Hydra/Chain/Direct/Contract/Decrement.hs

@@ -26,19 +26,19 @@ import Hydra.ContestationPeriod (ContestationPeriod, toChain)
 import Hydra.Contract.Error (ToErrorCode (..))
 import Hydra.Contract.HeadError (HeadError (..))
 import Hydra.Contract.HeadState qualified as Head
-import Hydra.Crypto (MultiSignature (..))
+import Hydra.Crypto (HydraKey, MultiSignature (..), aggregate, sign, toPlutusSignatures)
 import Hydra.Data.Party qualified as OnChain
 import Hydra.Ledger (IsTx (hashUTxO, withoutUTxO))
 import Hydra.Ledger.Cardano (
   adaOnly,
   genTxOut,
   genVerificationKey,
  )
-import Hydra.Party (Party, partyToChain, vkey)
+import Hydra.Party (Party, deriveParty, partyToChain, vkey)
 import Hydra.Plutus.Orphans ()
 import Hydra.Snapshot (Snapshot (..), SnapshotNumber)
 import PlutusTx.Builtins (toBuiltin)
-import Test.Hydra.Fixture (genForParty)
+import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty)
 import Test.QuickCheck (arbitrarySizedNatural, elements, oneof)
 import Test.QuickCheck.Gen (suchThat)
 import Test.QuickCheck.Instances ()
@@ -59,9 +59,7 @@ healthyDecrementTx =
       parameters
       (headInput, headOutput)
       healthySnapshot
-      multisig
-
-  multisig = HydraMultiSignature $ arbitrary `generateWith` 42
+      healthySignature
 
   parameters =
     HeadParameters
@@ -89,6 +87,12 @@ healthyDecrementTx =
         )
         healthyParties
 
+healthySigningKeys :: [SigningKey HydraKey]
+healthySigningKeys = [aliceSk, bobSk, carolSk]
+
+healthySignature :: MultiSignature (Snapshot Tx)
+healthySignature = aggregate [sign sk healthySnapshot | sk <- healthySigningKeys]
+
 healthySnapshotNumber :: SnapshotNumber
 healthySnapshotNumber = 1
 
@@ -137,9 +141,7 @@ healthyDatum =
     }
 
 healthyParties :: [Party]
-healthyParties =
-  [ generateWith arbitrary i | i <- [1 .. 3]
-  ]
+healthyParties = deriveParty <$> healthySigningKeys
 
 healthyOnChainParties :: [OnChain.Party]
 healthyOnChainParties = partyToChain <$> healthyParties

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

@@ -73,7 +73,8 @@ headValidator oldState input ctx =
       checkCollectCom ctx (contestationPeriod, parties, headId)
     (Initial{parties, headId}, Abort) ->
       checkAbort ctx headId parties
-    (Open{parties, contestationPeriod, snapshotNumber, headId}, Decrement{signature}) -> checkDecrement ctx parties snapshotNumber contestationPeriod headId signature
+    (Open{parties, contestationPeriod, snapshotNumber, headId}, Decrement{signature}) ->
+      checkDecrement ctx parties snapshotNumber contestationPeriod headId signature
     (Open{parties, utxoHash = initialUtxoHash, contestationPeriod, headId}, Close{signature}) ->
       checkClose ctx parties initialUtxoHash signature contestationPeriod headId
     (Closed{parties, snapshotNumber = closedSnapshotNumber, contestationDeadline, contestationPeriod, headId, contesters}, Contest{signature}) ->
@@ -235,11 +236,13 @@ checkDecrement ::
   CurrencySymbol ->
   [Signature] ->
   Bool
-checkDecrement ctx parties snapshotNumber cperiod headPolicyId _signature =
+checkDecrement ctx@ScriptContext{scriptContextTxInfo = txInfo} prevParties prevSnapshotNumber prevCperiod prevHeadId signature =
   mustNotChangeParameters
     && checkSnapshot
+    && checkSignatures
  where
-  (_, parties', snapshotNumber', cperiod', headId') =
+  decommitUtxoHash = hashTxOuts $ tail (txInfoOutputs txInfo)
+  (nextUtxoHash, nextParties, nextSnapshotNumber, nextCperiod, nextHeadId) =
     case fromBuiltinData @DatumType $ getDatum (headOutputDatum ctx) of
       Just
         Open
@@ -253,13 +256,16 @@ checkDecrement ctx parties snapshotNumber cperiod headPolicyId _signature =
 
   mustNotChangeParameters =
     traceIfFalse $(errorCode ChangedParameters) $
-      headId' == headPolicyId
-        && parties' == parties
-        && cperiod' == cperiod
+      prevHeadId == nextHeadId
+        && prevParties == nextParties
+        && prevCperiod == nextCperiod
 
   checkSnapshot =
     traceIfFalse $(errorCode SnapshotNumberMismatch) $
-      snapshotNumber' > snapshotNumber
+      nextSnapshotNumber > prevSnapshotNumber
+
+  checkSignatures =
+    verifySnapshotSignature nextParties nextHeadId nextSnapshotNumber nextUtxoHash decommitUtxoHash signature
 {-# INLINEABLE checkDecrement #-}
 
 -- | The close validator must verify that: