module Test.Cardano.Chain.UTxO.Gen (
  genCompactTxId,
  genCompactTxIn,
  genCompactTxOut,
  genVKWitness,
  genRedeemWitness,
  genTx,
  genTxAttributes,
  genTxAux,
  genTxHash,
  genTxId,
  genTxIn,
  genTxInList,
  genTxInWitness,
  genTxOut,
  genTxOutList,
  genTxPayload,
  genUTxOConfiguration,
  genTxProof,
  genTxSig,
  genTxSigData,
  genTxValidationError,
  genTxWitness,
  genUTxO,
  genUTxOError,
  genUTxOValidationError,
)
where

import Cardano.Chain.Common (makeNetworkMagic, mkAttributes)
import Cardano.Chain.UTxO (
  CompactTxId,
  CompactTxIn,
  CompactTxOut,
  Tx (..),
  TxAttributes,
  TxAux,
  TxId,
  TxIn (..),
  TxInWitness (..),
  TxOut (..),
  TxPayload,
  TxProof (..),
  TxSig,
  TxSigData (..),
  TxValidationError (..),
  TxWitness,
  UTxO,
  UTxOConfiguration (..),
  UTxOError (..),
  UTxOValidationError (..),
  fromList,
  mkTxAux,
  mkTxPayload,
  mkUTxOConfiguration,
  toCompactTxId,
  toCompactTxIn,
  toCompactTxOut,
 )
import Cardano.Crypto (
  Hash,
  ProtocolMagicId,
  decodeHash,
  getProtocolMagicId,
  sign,
 )
import Cardano.Prelude
import Data.ByteString.Base16 as B16
import Data.Coerce (coerce)
import qualified Data.Vector as V
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Chain.Common.Gen (
  genAddress,
  genLovelace,
  genLovelaceError,
  genMerkleRoot,
  genNetworkMagic,
 )
import Test.Cardano.Crypto.Gen (
  genAbstractHash,
  genProtocolMagic,
  genRedeemSignature,
  genRedeemVerificationKey,
  genSignTag,
  genSigningKey,
  genTextHash,
  genVerificationKey,
 )
import Test.Cardano.Prelude

genCompactTxId :: Gen CompactTxId
genCompactTxId :: Gen CompactTxId
genCompactTxId = Hash Tx -> CompactTxId
toCompactTxId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash Tx)
genTxId

genCompactTxIn :: Gen CompactTxIn
genCompactTxIn :: Gen CompactTxIn
genCompactTxIn = TxIn -> CompactTxIn
toCompactTxIn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
genTxIn

genCompactTxOut :: Gen CompactTxOut
genCompactTxOut :: Gen CompactTxOut
genCompactTxOut = TxOut -> CompactTxOut
toCompactTxOut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxOut
genTxOut

genVKWitness :: ProtocolMagicId -> Gen TxInWitness
genVKWitness :: ProtocolMagicId -> Gen TxInWitness
genVKWitness ProtocolMagicId
pm = VerificationKey -> TxSig -> TxInWitness
VKWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen VerificationKey
genVerificationKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> Gen TxSig
genTxSig ProtocolMagicId
pm

genRedeemWitness :: ProtocolMagicId -> Gen TxInWitness
genRedeemWitness :: ProtocolMagicId -> Gen TxInWitness
genRedeemWitness ProtocolMagicId
pm =
  RedeemVerificationKey -> RedeemSignature TxSigData -> TxInWitness
RedeemWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RedeemVerificationKey
genRedeemVerificationKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
EncCBOR a =>
ProtocolMagicId -> Gen a -> Gen (RedeemSignature a)
genRedeemSignature ProtocolMagicId
pm Gen TxSigData
genTxSigData

genTx :: Gen Tx
genTx :: Gen Tx
genTx = NonEmpty TxIn -> NonEmpty TxOut -> TxAttributes -> Tx
UnsafeTx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonEmpty TxIn)
genTxInList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (NonEmpty TxOut)
genTxOutList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TxAttributes
genTxAttributes

genTxAttributes :: Gen TxAttributes
genTxAttributes :: Gen TxAttributes
genTxAttributes = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall h. h -> Attributes h
mkAttributes ()

genTxAux :: ProtocolMagicId -> Gen TxAux
genTxAux :: ProtocolMagicId -> Gen TxAux
genTxAux ProtocolMagicId
pm = Tx -> TxWitness -> TxAux
mkTxAux forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Tx
genTx forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ProtocolMagicId -> Gen TxWitness
genTxWitness ProtocolMagicId
pm)

genTxHash :: Gen (Hash Tx)
genTxHash :: Gen (Hash Tx)
genTxHash = coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash Text)
genTextHash

genTxId :: Gen TxId
genTxId :: Gen (Hash Tx)
genTxId = GenT Identity Text
genBase16Text forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Text -> Either Text (Hash a)
decodeHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => Text -> a
panic forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    genBase16Text :: GenT Identity Text
genBase16Text = ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
genBase16Bs

genBase16Bs :: Gen ByteString
genBase16Bs :: Gen ByteString
genBase16Bs = ByteString -> ByteString
B16.encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
genBytes Int
32

genTxIn :: Gen TxIn
genTxIn :: Gen TxIn
genTxIn = Hash Tx -> Word16 -> TxIn
TxInUtxo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash Tx)
genTxId forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word16
genWord16

genTxInList :: Gen (NonEmpty TxIn)
genTxInList :: Gen (NonEmpty TxIn)
genTxInList = forall (m :: * -> *) a.
MonadGen m =>
Range Int -> m a -> m (NonEmpty a)
Gen.nonEmpty (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) Gen TxIn
genTxIn

genTxOut :: Gen TxOut
genTxOut :: Gen TxOut
genTxOut = Address -> Lovelace -> TxOut
TxOut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address
genAddress forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Lovelace
genLovelace

genTxOutList :: Gen (NonEmpty TxOut)
genTxOutList :: Gen (NonEmpty TxOut)
genTxOutList = forall (m :: * -> *) a.
MonadGen m =>
Range Int -> m a -> m (NonEmpty a)
Gen.nonEmpty (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
100) Gen TxOut
genTxOut

genUTxOConfiguration :: Gen UTxOConfiguration
genUTxOConfiguration :: Gen UTxOConfiguration
genUTxOConfiguration =
  [Address] -> UTxOConfiguration
mkUTxOConfiguration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
50) Gen Address
genAddress

genTxPayload :: ProtocolMagicId -> Gen TxPayload
genTxPayload :: ProtocolMagicId -> Gen TxPayload
genTxPayload ProtocolMagicId
pm = [TxAux] -> TxPayload
mkTxPayload forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) (ProtocolMagicId -> Gen TxAux
genTxAux ProtocolMagicId
pm)

genTxProof :: ProtocolMagicId -> Gen TxProof
genTxProof :: ProtocolMagicId -> Gen TxProof
genTxProof ProtocolMagicId
pm =
  Word32 -> MerkleRoot Tx -> Hash [TxWitness] -> TxProof
TxProof
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
genWord32
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. EncCBOR a => Gen a -> Gen (MerkleRoot a)
genMerkleRoot Gen Tx
genTx
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash
      (forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
5) (ProtocolMagicId -> Gen TxWitness
genTxWitness ProtocolMagicId
pm))

genTxSig :: ProtocolMagicId -> Gen TxSig
genTxSig :: ProtocolMagicId -> Gen TxSig
genTxSig ProtocolMagicId
pm = forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
pm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SignTag
genSignTag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SigningKey
genSigningKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TxSigData
genTxSigData

genTxSigData :: Gen TxSigData
genTxSigData :: Gen TxSigData
genTxSigData = Hash Tx -> TxSigData
TxSigData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash Tx)
genTxHash

genTxValidationError :: Gen TxValidationError
genTxValidationError :: Gen TxValidationError
genTxValidationError = do
  ProtocolMagic
pm <- Gen ProtocolMagic
genProtocolMagic
  let pmi :: ProtocolMagicId
pmi = forall a. AProtocolMagic a -> ProtocolMagicId
getProtocolMagicId ProtocolMagic
pm
      nm :: NetworkMagic
nm = forall a. AProtocolMagic a -> NetworkMagic
makeNetworkMagic ProtocolMagic
pm
  forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ Text -> LovelaceError -> TxValidationError
TxValidationLovelaceError
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (forall a. a -> a -> Range a
Range.constant Int
0 Int
1000) forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen LovelaceError
genLovelaceError
    , Tx -> Lovelace -> Lovelace -> TxValidationError
TxValidationFeeTooSmall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Tx
genTx forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Lovelace
genLovelace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Lovelace
genLovelace
    , TxInWitness -> ProtocolMagicId -> TxSigData -> TxValidationError
TxValidationWitnessWrongSignature
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> Gen TxInWitness
genTxInWitness ProtocolMagicId
pmi
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ProtocolMagicId
pmi
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TxSigData
genTxSigData
    , TxInWitness -> Address -> TxValidationError
TxValidationWitnessWrongKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> Gen TxInWitness
genTxInWitness ProtocolMagicId
pmi forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Address
genAddress
    , TxIn -> TxValidationError
TxValidationMissingInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
genTxIn
    , NetworkMagic -> NetworkMagic -> TxValidationError
TxValidationNetworkMagicMismatch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NetworkMagic
genNetworkMagic forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkMagic
nm
    , Natural -> Natural -> TxValidationError
TxValidationTxTooLarge
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. a -> a -> Range a
Range.constant Natural
0 Natural
1000)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. a -> a -> Range a
Range.constant Natural
0 Natural
1000)
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure TxValidationError
TxValidationUnknownAddressAttributes
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure TxValidationError
TxValidationUnknownAttributes
    ]

genTxInWitness :: ProtocolMagicId -> Gen TxInWitness
genTxInWitness :: ProtocolMagicId -> Gen TxInWitness
genTxInWitness ProtocolMagicId
pm = forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [ProtocolMagicId -> Gen TxInWitness
genVKWitness ProtocolMagicId
pm, ProtocolMagicId -> Gen TxInWitness
genRedeemWitness ProtocolMagicId
pm]

genTxWitness :: ProtocolMagicId -> Gen TxWitness
genTxWitness :: ProtocolMagicId -> Gen TxWitness
genTxWitness ProtocolMagicId
pm =
  forall a. [a] -> Vector a
V.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
10) (ProtocolMagicId -> Gen TxInWitness
genTxInWitness ProtocolMagicId
pm)

genUTxO :: Gen UTxO
genUTxO :: Gen UTxO
genUTxO = [(TxIn, TxOut)] -> UTxO
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. a -> a -> Range a
Range.constant Int
0 Int
1000) Gen (TxIn, TxOut)
genTxInTxOut
  where
    genTxInTxOut :: Gen (TxIn, TxOut)
    genTxInTxOut :: Gen (TxIn, TxOut)
genTxInTxOut = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
genTxIn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TxOut
genTxOut

genUTxOError :: Gen UTxOError
genUTxOError :: Gen UTxOError
genUTxOError =
  forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ TxIn -> UTxOError
UTxOMissingInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
genTxIn
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure UTxOError
UTxOOverlappingUnion
    ]

genUTxOValidationError :: Gen UTxOValidationError
genUTxOValidationError :: Gen UTxOValidationError
genUTxOValidationError =
  forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ TxValidationError -> UTxOValidationError
UTxOValidationTxValidationError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxValidationError
genTxValidationError
    , UTxOError -> UTxOValidationError
UTxOValidationUTxOError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTxOError
genUTxOError
    ]