Enforce (on-chain) that Hydra transitions are authenticated by participants

hydra-cluster/hydra-cluster.cabal

@@ -188,11 +188,11 @@ test-suite integration
   other-modules:
     Paths_hydra_cluster
     Spec
+    Test.CardanoClusterSpec
     Test.DirectChainSpec
     Test.EndToEndSpec
     Test.GeneratorSpec
     Test.Ledger.Cardano.ConfigurationSpec
-    Test.LocalClusterSpec
     Test.LogFilterSpec
 
   build-depends:

hydra-cluster/test/Test/CardanoClusterSpec.hs

@@ -0,0 +1,62 @@
+module Test.CardanoClusterSpec where
+
+import Hydra.Prelude
+import Test.Hydra.Prelude
+
+import CardanoCluster (
+  Actor (Alice),
+  ClusterConfig (..),
+  ClusterLog (..),
+  Marked (Normal),
+  RunningCluster (..),
+  defaultNetworkId,
+  keysFor,
+  seedFromFaucet_,
+  withCluster,
+ )
+import CardanoNode (ChainTip (..), RunningNode (..), cliQueryTip)
+import Hydra.Logging (Tracer, showLogsOnFailure)
+
+spec :: Spec
+spec =
+  it "should produce blocks, provide funds, and send Hydra OCV transactions" $ do
+    showLogsOnFailure $ \tr ->
+      withTempDir "hydra-cluster" $ \tmp -> do
+        let config =
+              ClusterConfig
+                { parentStateDirectory = tmp
+                , networkId = defaultNetworkId
+                }
+        withCluster tr config $ \cluster -> do
+          failAfter 30 $ assertNetworkIsProducingBlock tr cluster
+          failAfter 30 $ assertCanSpendInitialFunds cluster
+
+assertNetworkIsProducingBlock :: Tracer IO ClusterLog -> RunningCluster -> IO ()
+assertNetworkIsProducingBlock tracer = go (-1)
+ where
+  go blk cluster = case cluster of
+    RunningCluster _ (RunningNode nodeId socket : _) -> do
+      waitForNewBlock
+      tip <- cliQueryTip (contramap (MsgFromNode nodeId) tracer) socket
+      if block tip > blk
+        then pure ()
+        else go (block tip) cluster
+    _ ->
+      error "empty cluster?"
+
+assertCanSpendInitialFunds :: HasCallStack => RunningCluster -> IO ()
+assertCanSpendInitialFunds = \case
+  (RunningCluster ClusterConfig{networkId} (node : _)) -> do
+    (vk, _) <- keysFor Alice
+    seedFromFaucet_ networkId node vk 100_000_000 Normal
+  _ ->
+    error "empty cluster?"
+
+waitForNewBlock :: IO ()
+waitForNewBlock = threadDelay (2 * slotLength)
+
+slotLength :: DiffTime
+slotLength = 1 -- FIXME this should be found in the genesis file
+
+sshow :: (IsString s, Show a) => a -> s
+sshow = fromString . show

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

@@ -230,11 +230,11 @@ abort ::
   HasCallStack =>
   OnChainHeadState 'StInitialized ->
   Tx
-abort OnChainHeadState{networkId, stateMachine} = do
+abort OnChainHeadState{ownVerificationKey, stateMachine} = do
   let (i, o, dat, _) = initialThreadOutput
       initials = Map.fromList $ map tripleToPair initialInitials
       commits = Map.fromList $ map tripleToPair initialCommits
-   in case abortTx networkId (i, o, dat) (initialHeadTokenScript stateMachine) initials commits of
+   in case abortTx ownVerificationKey (i, o, dat) (initialHeadTokenScript stateMachine) initials commits of
         Left err ->
           -- FIXME: Exception with MonadThrow?
           error $ show err
@@ -250,9 +250,9 @@ abort OnChainHeadState{networkId, stateMachine} = do
 collect ::
   OnChainHeadState 'StInitialized ->
   Tx
-collect OnChainHeadState{networkId, stateMachine} = do
+collect OnChainHeadState{networkId, ownVerificationKey, stateMachine} = do
   let commits = Map.fromList $ fmap tripleToPair initialCommits
-   in collectComTx networkId initialThreadOutput commits
+   in collectComTx networkId ownVerificationKey initialThreadOutput commits
  where
   Initialized
     { initialThreadOutput
@@ -263,13 +263,13 @@ close ::
   ConfirmedSnapshot Tx ->
   OnChainHeadState 'StOpen ->
   Tx
-close confirmedSnapshot OnChainHeadState{stateMachine} = do
+close confirmedSnapshot OnChainHeadState{ownVerificationKey, stateMachine} = do
   let (sn, sigs) =
         case confirmedSnapshot of
           ConfirmedSnapshot{snapshot, signatures} -> (snapshot, signatures)
           InitialSnapshot{snapshot} -> (snapshot, mempty)
       (i, o, dat, _) = openThreadOutput
-   in closeTx sn sigs (i, o, dat)
+   in closeTx ownVerificationKey sn sigs (i, o, dat)
  where
   Open{openThreadOutput} = stateMachine
 

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

@@ -56,7 +56,7 @@ mkHeadTokenScript =
   fromPlutusScript @PlutusScriptV1 . HeadTokens.validatorScript . toPlutusTxOutRef
 
 hydraHeadV1AssetName :: AssetName
-hydraHeadV1AssetName = AssetName (fromBuiltin HeadTokens.hydraHeadV1)
+hydraHeadV1AssetName = AssetName (fromBuiltin Head.hydraHeadV1)
 
 -- FIXME: sould not be hardcoded
 headValue :: Value
@@ -178,6 +178,8 @@ mkCommitDatum (partyFromVerKey . vkey -> party) headValidatorHash utxo =
 -- i.e. driving the Head script state.
 collectComTx ::
   NetworkId ->
+  -- | Party who's authorizing this transaction
+  VerificationKey PaymentKey ->
   -- | Everything needed to spend the Head state-machine output.
   (TxIn, TxOut CtxUTxO, ScriptData, [OnChain.Party]) ->
   -- | Data needed to spend the commit output produced by each party.
@@ -187,11 +189,12 @@ collectComTx ::
 -- TODO(SN): utxo unused means other participants would not "see" the opened
 -- utxo when observing. Right now, they would be trusting the OCV checks this
 -- and construct their "world view" from observed commit txs in the HeadLogic
-collectComTx networkId (headInput, initialHeadOutput, ScriptDatumForTxIn -> headDatumBefore, parties) commits =
+collectComTx networkId vk (headInput, initialHeadOutput, ScriptDatumForTxIn -> headDatumBefore, parties) commits =
   unsafeBuildTransaction $
     emptyTxBody
       & addInputs ((headInput, headWitness) : (mkCommit <$> Map.toList commits))
       & addOutputs [headOutput]
+      & addExtraRequiredSigners [verificationKeyHash vk]
  where
   headWitness =
     BuildTxWith $ ScriptWitness scriptWitnessCtx $ mkScriptWitness headScript headDatumBefore headRedeemer
@@ -232,18 +235,21 @@ collectComTx networkId (headInput, initialHeadOutput, ScriptDatumForTxIn -> head
 
 -- | Create a transaction closing a head with given snapshot number and utxo.
 closeTx ::
+  -- | Party who's authorizing this transaction
+  VerificationKey PaymentKey ->
   Snapshot Tx ->
   -- | Multi-signature of the whole snapshot
   MultiSigned (Snapshot Tx) ->
   -- | Everything needed to spend the Head state-machine output.
   -- FIXME(SN): should also contain some Head identifier/address and stored Value (maybe the TxOut + Data?)
   UTxOWithScript ->
   Tx
-closeTx Snapshot{number, utxo} sig (headInput, headOutputBefore, ScriptDatumForTxIn -> headDatumBefore) =
+closeTx vk Snapshot{number, utxo} sig (headInput, headOutputBefore, ScriptDatumForTxIn -> headDatumBefore) =
   unsafeBuildTransaction $
     emptyTxBody
       & addInputs [(headInput, headWitness)]
       & addOutputs [headOutputAfter]
+      & addExtraRequiredSigners [verificationKeyHash vk]
  where
   headWitness =
     BuildTxWith $ ScriptWitness scriptWitnessCtx $ mkScriptWitness headScript headDatumBefore headRedeemer
@@ -299,8 +305,8 @@ data AbortTxError = OverlappingInputs
 -- | Create transaction which aborts a head by spending the Head output and all
 -- other "initial" outputs.
 abortTx ::
-  -- | Network identifier for address discrimination
-  NetworkId ->
+  -- | Party who's authorizing this transaction
+  VerificationKey PaymentKey ->
   -- | Everything needed to spend the Head state-machine output.
   (TxIn, TxOut CtxUTxO, ScriptData) ->
   -- | Script for monetary policy to burn tokens
@@ -312,7 +318,7 @@ abortTx ::
   -- Should contain the PT and is locked by commit script.
   Map TxIn (TxOut CtxUTxO, ScriptData) ->
   Either AbortTxError Tx
-abortTx _networkId (headInput, initialHeadOutput, ScriptDatumForTxIn -> headDatumBefore) headTokenScript initialsToAbort commitsToAbort
+abortTx vk (headInput, initialHeadOutput, ScriptDatumForTxIn -> headDatumBefore) headTokenScript initialsToAbort commitsToAbort
   | isJust (lookup headInput initialsToAbort) =
     Left OverlappingInputs
   | otherwise =
@@ -322,6 +328,7 @@ abortTx _networkId (headInput, initialHeadOutput, ScriptDatumForTxIn -> headDatu
           & addInputs ((headInput, headWitness) : initialInputs <> commitInputs)
           & addOutputs commitOutputs
           & burnTokens headTokenScript Burn headTokens
+          & addExtraRequiredSigners [verificationKeyHash vk]
  where
   headWitness =
     BuildTxWith $ ScriptWitness scriptWitnessCtx $ mkScriptWitness headScript headDatumBefore headRedeemer

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

@@ -6,12 +6,18 @@ module Hydra.Chain.Direct.Util where
 import Hydra.Prelude
 
 import qualified Cardano.Crypto.DSIGN as Crypto
+import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..))
+import Cardano.Ledger.Alonzo.TxWitness (TxWitness (..))
 import Cardano.Ledger.Crypto (DSIGN)
+import qualified Cardano.Ledger.SafeHash as SafeHash
+import qualified Cardano.Ledger.TxIn as Ledger
 import Cardano.Slotting.Slot (WithOrigin (..))
 import Control.Tracer (nullTracer)
 import Data.Map.Strict ((!))
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import Hydra.Cardano.Api hiding (AlonzoEra, Block, SigningKey, VerificationKey)
+import qualified Hydra.Cardano.Api as Api
 import qualified Hydra.Cardano.Api as Shelley
 import Ouroboros.Consensus.Byron.Ledger.Config (CodecConfig (..))
 import Ouroboros.Consensus.Cardano (CardanoBlock)
@@ -174,6 +180,22 @@ retry predicate action =
  where
   catchIf f a b = a `catch` \e -> if f e then b e else throwIO e
 
+signWith ::
+  (Api.VerificationKey Api.PaymentKey, Api.SigningKey Api.PaymentKey) ->
+  ValidatedTx Api.LedgerEra ->
+  ValidatedTx Api.LedgerEra
+signWith credentials validatedTx@ValidatedTx{body, wits} =
+  validatedTx
+    { wits =
+        wits{txwitsVKey = Set.union (txwitsVKey wits) sig}
+    }
+ where
+  txid =
+    Ledger.TxId (SafeHash.hashAnnotated body)
+  sig =
+    toLedgerKeyWitness
+      [Api.signWith @Api.Era (fromLedgerTxId txid) credentials]
+
 -- | Marker datum used to identify payment UTXO
 markerDatum :: Data
 markerDatum = toData $ toBuiltinData ("Hydra Head Payment" :: BuiltinByteString)