-- | 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 :: forall a. Gen a -> Party -> a
genForParty Gen a
gen Party{VerificationKey HydraKey
vkey :: VerificationKey HydraKey
$sel:vkey:Party :: Party -> 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

genBytes :: Gen ByteString
genBytes :: Gen ByteString
genBytes = Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary

genHash :: Gen ByteString
genHash :: Gen ByteString
genHash = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
32

-- | Generates value such that:
-- - alters between policy id we use in test fixtures with a random one.
-- - mixing arbitrary token names with 'hydraHeadV1'
-- - excluding 0 for quantity to mimic minting/burning
genMintedOrBurnedValue :: Gen Value
genMintedOrBurnedValue :: Gen Value
genMintedOrBurnedValue = do
  PolicyId
policyId <-
    [Gen PolicyId] -> Gen PolicyId
forall a. [Gen a] -> Gen a
oneof
      [ TxIn -> PolicyId
headPolicyId (TxIn -> PolicyId) -> Gen TxIn -> Gen PolicyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary
      , PolicyId -> Gen PolicyId
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PolicyId
Fixtures.testPolicyId
      ]
  AssetName
tokenName <- [Gen AssetName] -> Gen AssetName
forall a. [Gen a] -> Gen a
oneof [Gen AssetName
forall a. Arbitrary a => Gen a
arbitrary, AssetName -> Gen AssetName
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> AssetName
AssetName (ByteString -> AssetName) -> ByteString -> AssetName
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin BuiltinByteString
hydraHeadV1)]
  Integer
quantity <- Gen Integer
forall a. Arbitrary a => Gen a
arbitrary Gen Integer -> (Integer -> Bool) -> Gen Integer
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
  Value -> Gen Value
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Gen Value) -> Value -> Gen Value
forall a b. (a -> b) -> a -> b
$ [(AssetId, Quantity)] -> Value
valueFromList [(PolicyId -> AssetName -> AssetId
AssetId PolicyId
policyId AssetName
tokenName, Integer -> Quantity
Quantity Integer
quantity)]