-- | Test and example values used across hydra-node tests.
module Test.Hydra.Fixture where

import Hydra.Prelude

import Cardano.Crypto.Hash (hashToBytes)
import Codec.CBOR.Magic (uintegerFromBytes)
import Hydra.Cardano.Api (Key (..), PaymentKey, SerialiseAsRawBytes (..), SigningKey, VerificationKey, getVerificationKey)
import Hydra.Chain (HeadParameters (..))
import Hydra.ContestationPeriod (ContestationPeriod (..))
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 :: Party
alice = SigningKey HydraKey -> Party
deriveParty SigningKey HydraKey
aliceSk
bob :: Party
bob = SigningKey HydraKey -> Party
deriveParty SigningKey HydraKey
bobSk
carol :: Party
carol = SigningKey HydraKey -> Party
deriveParty SigningKey HydraKey
carolSk

-- | Hydra signing keys for 'alice', 'bob', and 'carol'.
aliceSk, bobSk, carolSk :: SigningKey HydraKey
aliceSk :: SigningKey HydraKey
aliceSk = ByteString -> SigningKey HydraKey
generateSigningKey ByteString
"alice"
bobSk :: SigningKey HydraKey
bobSk = ByteString -> SigningKey HydraKey
generateSigningKey ByteString
"bob"
-- NOTE: Using 'zcarol' as seed results in ordered 'deriveParty' values
carolSk :: SigningKey HydraKey
carolSk = ByteString -> SigningKey HydraKey
generateSigningKey ByteString
"zcarol"

-- | Hydra verification keys for 'alice', 'bob', and 'carol'.
aliceVk, bobVk, carolVk :: VerificationKey HydraKey
aliceVk :: VerificationKey HydraKey
aliceVk = SigningKey HydraKey -> VerificationKey HydraKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey HydraKey
aliceSk
bobVk :: VerificationKey HydraKey
bobVk = SigningKey HydraKey -> VerificationKey HydraKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey HydraKey
bobSk
carolVk :: VerificationKey HydraKey
carolVk = SigningKey HydraKey -> VerificationKey HydraKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey HydraKey
carolSk

-- | Cardano payment keys for 'alice', 'bob', and 'carol'.
alicePVk, bobPVk, carolPVk :: VerificationKey PaymentKey
alicePVk :: VerificationKey PaymentKey
alicePVk = Gen (VerificationKey PaymentKey)
genVerificationKey Gen (VerificationKey PaymentKey)
-> Party -> VerificationKey PaymentKey
forall a. Gen a -> Party -> a
`genForParty` Party
alice
bobPVk :: VerificationKey PaymentKey
bobPVk = Gen (VerificationKey PaymentKey)
genVerificationKey Gen (VerificationKey PaymentKey)
-> Party -> VerificationKey PaymentKey
forall a. Gen a -> Party -> a
`genForParty` Party
bob
carolPVk :: VerificationKey PaymentKey
carolPVk = Gen (VerificationKey PaymentKey)
genVerificationKey Gen (VerificationKey PaymentKey)
-> Party -> VerificationKey PaymentKey
forall a. Gen a -> Party -> a
`genForParty` Party
carol

cperiod :: ContestationPeriod
cperiod :: ContestationPeriod
cperiod = Natural -> ContestationPeriod
UnsafeContestationPeriod Natural
42

testHeadId :: HeadId
testHeadId :: HeadId
testHeadId = ByteString -> HeadId
UnsafeHeadId ByteString
"1234"

testHeadSeed :: HeadSeed
testHeadSeed :: HeadSeed
testHeadSeed = ByteString -> HeadSeed
UnsafeHeadSeed ByteString
"000000000000000000#0"

-- | Derive some 'OnChainId' from a Hydra party. In the real protocol this is
-- currently not done, but in this simulated chain setting this is definitely
-- fine.
deriveOnChainId :: Party -> OnChainId
deriveOnChainId :: Party -> OnChainId
deriveOnChainId Party{VerificationKey HydraKey
vkey :: VerificationKey HydraKey
$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey} =
  case AsType OnChainId
-> ByteString -> Either SerialiseAsRawBytesError OnChainId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType OnChainId
AsOnChainId ByteString
bytes of
    Left SerialiseAsRawBytesError
_ -> Text -> OnChainId
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"deriveOnChainId failed"
    Right OnChainId
oid -> OnChainId
oid
 where
  bytes :: ByteString
bytes = Hash HydraKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes (Hash HydraKey -> ByteString) -> Hash HydraKey -> ByteString
forall a b. (a -> b) -> a -> b
$ VerificationKey HydraKey -> Hash HydraKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey HydraKey
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 :: forall a. Gen a -> Party -> a
genForParty Gen a
gen Party{VerificationKey HydraKey
$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey :: VerificationKey HydraKey
vkey} =
  Gen a -> Int -> a
forall a. Gen a -> Int -> a
generateWith Gen a
gen Int
seed
 where
  seed :: Int
seed =
    Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      (Integer -> Int)
-> (Hash HydraKey -> Integer) -> Hash HydraKey -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
uintegerFromBytes
      (ByteString -> Integer)
-> (Hash HydraKey -> ByteString) -> Hash HydraKey -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HydraKey -> ByteString
hydraKeyHashToBytes
      (Hash HydraKey -> Int) -> Hash HydraKey -> Int
forall a b. (a -> b) -> a -> b
$ VerificationKey HydraKey -> Hash HydraKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey HydraKey
vkey

  hydraKeyHashToBytes :: Hash HydraKey -> ByteString
hydraKeyHashToBytes (HydraKeyHash Hash Blake2b_256 (VerificationKey HydraKey)
h) = Hash Blake2b_256 (VerificationKey HydraKey) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash Blake2b_256 (VerificationKey HydraKey)
h

-- | An environment fixture for testing.
testEnvironment :: Environment
testEnvironment :: Environment
testEnvironment =
  Environment
    { $sel:party:Environment :: Party
party = Party
alice
    , $sel:signingKey:Environment :: SigningKey HydraKey
signingKey = SigningKey HydraKey
aliceSk
    , $sel:otherParties:Environment :: [Party]
otherParties = [Party
bob, Party
carol]
    , $sel:contestationPeriod:Environment :: ContestationPeriod
contestationPeriod = ContestationPeriod
cperiod
    , $sel:participants:Environment :: [OnChainId]
participants = Party -> OnChainId
deriveOnChainId (Party -> OnChainId) -> [Party] -> [OnChainId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Party
alice, Party
bob, Party
carol]
    }

-- | Head parameters fixture for testing.
testHeadParameters :: HeadParameters
testHeadParameters :: HeadParameters
testHeadParameters =
  HeadParameters
    { $sel:contestationPeriod:HeadParameters :: ContestationPeriod
contestationPeriod = ContestationPeriod
cperiod
    , $sel:parties:HeadParameters :: [Party]
parties = [Party
alice, Party
bob, Party
carol]
    }