Move genForParty into Test.Hydra.Fixture

Also adds cardano payment key fixtures.

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

@@ -11,7 +11,7 @@ import Cardano.Api.UTxO qualified as UTxO
 import Data.List qualified as List
 import Data.Map qualified as Map
 import Hydra.Chain (HeadParameters (..))
-import Hydra.Chain.Direct.Contract.Gen (genForParty)
+import Test.Hydra.Fixture (genForParty)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),

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

@@ -8,7 +8,7 @@ import Hydra.Prelude hiding (label)
 
 import Cardano.Api.UTxO as UTxO
 import Data.Maybe (fromJust)
-import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue)
+import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),
@@ -24,7 +24,6 @@ import Hydra.Chain.Direct.Contract.Mutation (
   replaceSnapshotNumber,
   replaceUtxoHash,
  )
-import Hydra.Chain.Direct.Fixture (testNetworkId)
 import Hydra.Chain.Direct.Fixture qualified as Fixture
 import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
 import Hydra.Chain.Direct.TimeHandle (PointInTime)
@@ -47,7 +46,7 @@ import Hydra.Plutus.Orphans ()
 import Hydra.Snapshot (Snapshot (..), SnapshotNumber)
 import PlutusLedgerApi.V1.Time (DiffMilliSeconds (..), fromMilliSeconds)
 import PlutusLedgerApi.V2 (BuiltinByteString, POSIXTime, PubKeyHash (PubKeyHash), toBuiltin)
-import Test.Hydra.Fixture (aliceSk, bobSk, carolSk)
+import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty)
 import Test.QuickCheck (arbitrarySizedNatural, choose, elements, listOf1, oneof, suchThat)
 import Test.QuickCheck.Instances ()
 
@@ -136,7 +135,7 @@ healthyOpenHeadTxIn = generateWith arbitrary 42
 
 healthyOpenHeadTxOut :: TxOut CtxUTxO
 healthyOpenHeadTxOut =
-  mkHeadOutput testNetworkId Fixture.testPolicyId headTxOutDatum
+  mkHeadOutput Fixture.testNetworkId Fixture.testPolicyId headTxOutDatum
     & addParticipationTokens healthyParticipants
  where
   headTxOutDatum = toUTxOContext (mkTxOutDatumInline healthyOpenHeadDatum)
@@ -293,7 +292,7 @@ genCloseMutation :: (Tx, UTxO) -> Gen SomeMutation
 genCloseMutation (tx, _utxo) =
   oneof
     [ SomeMutation (Just $ toErrorCode NotPayingToHead) NotContinueContract <$> do
-        mutatedAddress <- genAddressInEra testNetworkId
+        mutatedAddress <- genAddressInEra Fixture.testNetworkId
         pure $ ChangeOutput 0 (modifyTxOutAddress (const mutatedAddress) headTxOut)
     , SomeMutation (Just $ toErrorCode SignatureVerificationFailed) MutateSignatureButNotSnapshotNumber . ChangeHeadRedeemer <$> do
         Head.Close . toPlutusSignatures <$> (arbitrary :: Gen (MultiSignature (Snapshot Tx)))

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

@@ -11,7 +11,7 @@ import Data.List qualified as List
 import Data.Map qualified as Map
 import Data.Maybe (fromJust)
 import Hydra.Chain (HeadParameters (..))
-import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue)
+import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),
@@ -52,6 +52,7 @@ import Hydra.OnChainId (OnChainId)
 import Hydra.Party (Party, partyToChain)
 import Hydra.Plutus.Orphans ()
 import PlutusTx.Builtins (toBuiltin)
+import Test.Hydra.Fixture (genForParty)
 import Test.QuickCheck (choose, elements, oneof, suchThat)
 import Test.QuickCheck.Instances ()
 

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

@@ -9,7 +9,7 @@ import Hydra.Prelude hiding (label)
 import Data.Maybe (fromJust)
 
 import Cardano.Api.UTxO as UTxO
-import Hydra.Chain.Direct.Contract.Gen (genForParty, genHash, genMintedOrBurnedValue)
+import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),
@@ -48,7 +48,7 @@ import Hydra.Plutus.Orphans ()
 import Hydra.Snapshot (Snapshot (..), SnapshotNumber)
 import PlutusLedgerApi.V2 (BuiltinByteString, toBuiltin)
 import PlutusLedgerApi.V2 qualified as Plutus
-import Test.Hydra.Fixture (aliceSk, bobSk, carolSk)
+import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty)
 import Test.QuickCheck (arbitrarySizedNatural, elements, listOf, listOf1, oneof, suchThat, vectorOf)
 import Test.QuickCheck.Gen (choose)
 import Test.QuickCheck.Instances ()

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

@@ -1,37 +1,17 @@
 -- | Generators used in mutation testing framework
 module Hydra.Chain.Direct.Contract.Gen where
 
-import Cardano.Crypto.Hash (hashToBytes)
-import Codec.CBOR.Magic (uintegerFromBytes)
 import Data.ByteString qualified as BS
 import Hydra.Cardano.Api
 import Hydra.Chain.Direct.Fixture qualified as Fixtures
 import Hydra.Contract.HeadTokens (headPolicyId)
 import Hydra.Contract.Util (hydraHeadV1)
-import Hydra.Crypto (Hash (HydraKeyHash))
-import Hydra.Party (Party (..))
 import Hydra.Prelude
 import PlutusTx.Builtins (fromBuiltin)
 import Test.QuickCheck (oneof, suchThat, vector)
 
 -- * Party / key utilities
 
--- | Generate some 'a' given the Party as a seed. NOTE: While this is useful to
--- generate party-specific values, it DOES depend on the generator used. For
--- example, `genForParty genVerificationKey` and `genForParty (fst <$>
--- genKeyPair)` do not yield the same verification keys!
-genForParty :: Gen a -> Party -> a
-genForParty gen Party{vkey} =
-  generateWith gen seed
- where
-  seed =
-    fromIntegral
-      . uintegerFromBytes
-      . hydraKeyHashToBytes
-      $ verificationKeyHash vkey
-
-  hydraKeyHashToBytes (HydraKeyHash h) = hashToBytes h
-
 genBytes :: Gen ByteString
 genBytes = arbitrary
 

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

@@ -10,7 +10,7 @@ import Hydra.Prelude
 import Cardano.Api.UTxO qualified as UTxO
 import Data.Maybe (fromJust)
 import Hydra.Chain (HeadParameters (..))
-import Hydra.Chain.Direct.Contract.Gen (genForParty)
+import Test.Hydra.Fixture (genForParty)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
   SomeMutation (..),

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

@@ -17,7 +17,7 @@ import Data.Map qualified as Map
 import Data.Text qualified as T
 import Hydra.Cardano.Api.Pretty (renderTx)
 import Hydra.Chain (HeadParameters (..))
-import Hydra.Chain.Direct.Contract.Gen (genForParty)
+import Test.Hydra.Fixture (genForParty)
 import Hydra.Chain.Direct.Fixture (
   epochInfo,
   pparams,

hydra-node/test/Test/Hydra/Fixture.hs

@@ -3,31 +3,40 @@ module Test.Hydra.Fixture where
 
 import Hydra.Prelude
 
-import Hydra.Cardano.Api (Key (..), SerialiseAsRawBytes (..), SigningKey, VerificationKey, getVerificationKey)
+import Cardano.Crypto.Hash (hashToBytes)
+import Codec.CBOR.Magic (uintegerFromBytes)
+import Hydra.Cardano.Api (Key (..), PaymentKey, SerialiseAsRawBytes (..), SigningKey, VerificationKey, getVerificationKey)
 import Hydra.ContestationPeriod (ContestationPeriod (..))
-import Hydra.Crypto (HydraKey, generateSigningKey)
+import Hydra.Crypto (Hash (..), HydraKey, generateSigningKey)
 import Hydra.Environment (Environment (..))
 import Hydra.HeadId (HeadId (..), HeadSeed (..))
+import Hydra.Ledger.Cardano (genVerificationKey)
 import Hydra.OnChainId (AsType (AsOnChainId), OnChainId)
 import Hydra.Party (Party (..), deriveParty)
 
+-- | Our beloved alice, bob, and carol.
 alice, bob, carol :: Party
 alice = deriveParty aliceSk
 bob = deriveParty bobSk
 carol = deriveParty carolSk
 
+-- | Hydra signing keys for 'alice', 'bob', and 'carol'.
 aliceSk, bobSk, carolSk :: SigningKey HydraKey
 aliceSk = generateSigningKey "alice"
 bobSk = generateSigningKey "bob"
-carolSk = generateSigningKey "zcarol"
+carolSk = generateSigningKey "carol"
 
+-- | Hydra verification keys for 'alice', 'bob', and 'carol'.
 aliceVk, bobVk, carolVk :: VerificationKey HydraKey
 aliceVk = getVerificationKey aliceSk
 bobVk = getVerificationKey bobSk
 carolVk = getVerificationKey carolSk
 
-allVKeys :: [VerificationKey HydraKey]
-allVKeys = vkey <$> [alice, bob, carol]
+-- | Cardano payment keys for 'alice', 'bob', and 'carol'.
+alicePVk, bobPVk, carolPVk :: VerificationKey PaymentKey
+alicePVk = genVerificationKey `genForParty` alice
+bobPVk = genVerificationKey `genForParty` bob
+carolPVk = genVerificationKey `genForParty` carol
 
 cperiod :: ContestationPeriod
 cperiod = UnsafeContestationPeriod 42
@@ -49,6 +58,22 @@ deriveOnChainId Party{vkey} =
  where
   bytes = serialiseToRawBytes $ verificationKeyHash vkey
 
+-- | Generate some 'a' given the Party as a seed. NOTE: While this is useful to
+-- generate party-specific values, it DOES depend on the generator used. For
+-- example, `genForParty genVerificationKey` and `genForParty (fst <$>
+-- genKeyPair)` do not yield the same verification keys!
+genForParty :: Gen a -> Party -> a
+genForParty gen Party{vkey} =
+  generateWith gen seed
+ where
+  seed =
+    fromIntegral
+      . uintegerFromBytes
+      . hydraKeyHashToBytes
+      $ verificationKeyHash vkey
+
+  hydraKeyHashToBytes (HydraKeyHash h) = hashToBytes h
+
 -- | An environment fixture for testing.
 testEnvironment :: Environment
 testEnvironment =