{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeFamilies       #-}

{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Temporary code that'll make it easy for us to generate arbitrary events.
-- This should either be deleted when we can get real events, or at least moved
-- across to the test suite.
module Plutus.PAB.Arbitrary where

import Cardano.Api qualified as C
import Cardano.Node.Emulator.Internal.Node.Params (testnet)
import Control.Monad (replicateM)
import Data.Aeson (Value)
import Data.Aeson qualified as Aeson
import Data.ByteString (ByteString)
import Data.Either.Combinators (rightToMaybe)
import Ledger (TxOut (TxOut))
import Ledger qualified
import Ledger.Address (PaymentPubKey, PaymentPubKeyHash, StakePubKey, StakePubKeyHash)
import Ledger.Crypto (PubKey, Signature)
import Ledger.Interval (Extended, Interval, LowerBound, UpperBound)
import Ledger.Scripts (Language (..), Versioned (..))
import Ledger.Slot (Slot)
import Ledger.Tx (Certificate, RedeemerPtr, ScriptTag, TxOutRef, Withdrawal)
import Ledger.Tx.CardanoAPI (ToCardanoError, toCardanoAddressInEra, toCardanoTxOut)
import Ledger.Tx.Constraints (MkTxError)
import Ledger.Value.CardanoAPI (policyId)
import Plutus.Contract.Effects (ActiveEndpoint (..), PABReq (..), PABResp (..))
import Plutus.Contract.StateMachine (ThreadToken)
import Plutus.Script.Utils.Ada qualified as Plutus
import Plutus.Script.Utils.V1.Address (mkValidatorAddress)
import Plutus.Script.Utils.V1.Typed.Scripts (ConnectionError, WrongOutTypeError)
import Plutus.Script.Utils.Value qualified as Plutus
import Plutus.V1.Ledger.Api (Address (..), LedgerBytes, PubKeyHash, ValidatorHash (ValidatorHash))
import Plutus.V1.Ledger.Bytes qualified as LedgerBytes
import Plutus.V2.Ledger.Api qualified as PV2
import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Prelude qualified as PlutusTx
import Test.QuickCheck (Gen, Positive (..), oneof, sized, suchThatMap)
import Test.QuickCheck.Arbitrary.Generic (Arbitrary, Arg, arbitrary, genericArbitrary, genericShrink, shrink)
import Test.QuickCheck.Instances ()
import Wallet.Types (EndpointDescription (..), EndpointValue (..))

-- | A validator that always succeeds.
acceptingValidator :: Ledger.Validator
acceptingValidator :: Validator
acceptingValidator = CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())
-> Validator
Ledger.mkValidatorScript $$(PlutusTx.compile [|| (\_ _ _ -> ()) ||])

-- | A minting policy that always succeeds.
acceptingMintingPolicy :: Ledger.MintingPolicy
acceptingMintingPolicy :: MintingPolicy
acceptingMintingPolicy = CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy
Ledger.mkMintingPolicyScript $$(PlutusTx.compile [|| (\_ _ -> ()) ||])

instance Arbitrary PlutusTx.BuiltinByteString where
    arbitrary :: Gen BuiltinByteString
arbitrary = ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> Gen ByteString -> Gen BuiltinByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary :: Gen ByteString)

instance Arbitrary LedgerBytes where
    arbitrary :: Gen LedgerBytes
arbitrary = ByteString -> LedgerBytes
LedgerBytes.fromBytes (ByteString -> LedgerBytes) -> Gen ByteString -> Gen LedgerBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary Ledger.MintingPolicy where
    arbitrary :: Gen MintingPolicy
arbitrary = MintingPolicy -> Gen MintingPolicy
forall (f :: * -> *) a. Applicative f => a -> f a
pure MintingPolicy
acceptingMintingPolicy

instance Arbitrary Ledger.MintingPolicyHash where
    arbitrary :: Gen MintingPolicyHash
arbitrary = Gen MintingPolicyHash
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: MintingPolicyHash -> [MintingPolicyHash]
shrink = MintingPolicyHash -> [MintingPolicyHash]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Ledger.Script where
    arbitrary :: Gen Script
arbitrary = [Gen Script] -> Gen Script
forall a. [Gen a] -> Gen a
oneof [
          Script -> Gen Script
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Script -> Gen Script) -> Script -> Gen Script
forall a b. (a -> b) -> a -> b
$ Validator -> Script
Ledger.unValidatorScript Validator
acceptingValidator
        , Script -> Gen Script
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Script -> Gen Script) -> Script -> Gen Script
forall a b. (a -> b) -> a -> b
$ MintingPolicy -> Script
Ledger.unMintingPolicyScript MintingPolicy
acceptingMintingPolicy
        ]

instance Arbitrary Ledger.ScriptHash where
    arbitrary :: Gen ScriptHash
arbitrary = Gen ScriptHash
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: ScriptHash -> [ScriptHash]
shrink = ScriptHash -> [ScriptHash]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink
instance Arbitrary Ledger.ScriptError where
    arbitrary :: Gen ScriptError
arbitrary = Gen ScriptError
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: ScriptError -> [ScriptError]
shrink = ScriptError -> [ScriptError]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary MkTxError where
    arbitrary :: Gen MkTxError
arbitrary = Gen MkTxError
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: MkTxError -> [MkTxError]
shrink = MkTxError -> [MkTxError]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary ConnectionError where
    arbitrary :: Gen ConnectionError
arbitrary = Gen ConnectionError
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: ConnectionError -> [ConnectionError]
shrink = ConnectionError -> [ConnectionError]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary WrongOutTypeError where
    arbitrary :: Gen WrongOutTypeError
arbitrary = Gen WrongOutTypeError
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: WrongOutTypeError -> [WrongOutTypeError]
shrink = WrongOutTypeError -> [WrongOutTypeError]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary ToCardanoError where
    arbitrary :: Gen ToCardanoError
arbitrary = Gen ToCardanoError
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: ToCardanoError -> [ToCardanoError]
shrink = ToCardanoError -> [ToCardanoError]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PV2.OutputDatum where
    arbitrary :: Gen OutputDatum
arbitrary = Gen OutputDatum
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: OutputDatum -> [OutputDatum]
shrink = OutputDatum -> [OutputDatum]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary TxOut where
    arbitrary :: Gen TxOut
arbitrary = (TxOut -> Either ToCardanoError TxOut)
-> Gen TxOut -> Gen (Either ToCardanoError TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TxOut CtxTx BabbageEra -> TxOut)
-> Either ToCardanoError (TxOut CtxTx BabbageEra)
-> Either ToCardanoError TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOut CtxTx BabbageEra -> TxOut
TxOut (Either ToCardanoError (TxOut CtxTx BabbageEra)
 -> Either ToCardanoError TxOut)
-> (TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra))
-> TxOut
-> Either ToCardanoError TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkId
-> TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra)
toCardanoTxOut NetworkId
testnet) Gen TxOut
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary Gen (Either ToCardanoError TxOut)
-> (Either ToCardanoError TxOut -> Maybe TxOut) -> Gen TxOut
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` Either ToCardanoError TxOut -> Maybe TxOut
forall a b. Either a b -> Maybe b
rightToMaybe
    shrink :: TxOut -> [TxOut]
shrink = TxOut -> [TxOut]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Arbitrary TxOutRef where
    arbitrary :: Gen TxOutRef
arbitrary = Gen TxOutRef
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: TxOutRef -> [TxOutRef]
shrink = TxOutRef -> [TxOutRef]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Withdrawal where
    arbitrary :: Gen Withdrawal
arbitrary = Gen Withdrawal
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Withdrawal -> [Withdrawal]
shrink = Withdrawal -> [Withdrawal]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Certificate where
    arbitrary :: Gen Certificate
arbitrary = Gen Certificate
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Certificate -> [Certificate]
shrink = Certificate -> [Certificate]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Ledger.Credential where
    arbitrary :: Gen Credential
arbitrary = Gen Credential
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Credential -> [Credential]
shrink = Credential -> [Credential]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Ledger.StakingCredential where
    arbitrary :: Gen StakingCredential
arbitrary = Gen StakingCredential
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: StakingCredential -> [StakingCredential]
shrink = StakingCredential -> [StakingCredential]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Ledger.DCert where
    arbitrary :: Gen DCert
arbitrary = Gen DCert
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: DCert -> [DCert]
shrink = DCert -> [DCert]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary ScriptTag where
    arbitrary :: Gen ScriptTag
arbitrary = Gen ScriptTag
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: ScriptTag -> [ScriptTag]
shrink = ScriptTag -> [ScriptTag]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary RedeemerPtr where
    arbitrary :: Gen RedeemerPtr
arbitrary = Gen RedeemerPtr
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: RedeemerPtr -> [RedeemerPtr]
shrink = RedeemerPtr -> [RedeemerPtr]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Value where
    arbitrary :: Gen Value
arbitrary = [Gen Value] -> Gen Value
forall a. [Gen a] -> Gen a
oneof [Text -> Value
Aeson.String (Text -> Value) -> Gen Text -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary, Scientific -> Value
Aeson.Number (Scientific -> Value) -> Gen Scientific -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scientific
forall a. Arbitrary a => Gen a
arbitrary]

instance (Arg (Extended a) a, Arbitrary a) => Arbitrary (Extended a) where
    arbitrary :: Gen (Extended a)
arbitrary = Gen (Extended a)
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Extended a -> [Extended a]
shrink = Extended a -> [Extended a]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (Arg (Extended a) a, Arg (LowerBound a) a, Arbitrary a) => Arbitrary (LowerBound a) where
    arbitrary :: Gen (LowerBound a)
arbitrary = Gen (LowerBound a)
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: LowerBound a -> [LowerBound a]
shrink = LowerBound a -> [LowerBound a]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (Arg (Extended a) a, Arg (UpperBound a) a, Arbitrary a) => Arbitrary (UpperBound a) where
    arbitrary :: Gen (UpperBound a)
arbitrary = Gen (UpperBound a)
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: UpperBound a -> [UpperBound a]
shrink = UpperBound a -> [UpperBound a]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (Arg (Extended a) a, Arg (LowerBound a) a, Arg (UpperBound a) a, Arg (Interval a) a, Arbitrary a) => Arbitrary (Interval a) where
    arbitrary :: Gen (Interval a)
arbitrary = Gen (Interval a)
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Interval a -> [Interval a]
shrink = Interval a -> [Interval a]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PubKey where
    arbitrary :: Gen PubKey
arbitrary = Gen PubKey
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: PubKey -> [PubKey]
shrink = PubKey -> [PubKey]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PubKeyHash where
    arbitrary :: Gen PubKeyHash
arbitrary = Gen PubKeyHash
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: PubKeyHash -> [PubKeyHash]
shrink = PubKeyHash -> [PubKeyHash]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PaymentPubKey where
    arbitrary :: Gen PaymentPubKey
arbitrary = Gen PaymentPubKey
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: PaymentPubKey -> [PaymentPubKey]
shrink = PaymentPubKey -> [PaymentPubKey]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PaymentPubKeyHash where
    arbitrary :: Gen PaymentPubKeyHash
arbitrary = Gen PaymentPubKeyHash
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: PaymentPubKeyHash -> [PaymentPubKeyHash]
shrink = PaymentPubKeyHash -> [PaymentPubKeyHash]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary StakePubKey where
    arbitrary :: Gen StakePubKey
arbitrary = Gen StakePubKey
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: StakePubKey -> [StakePubKey]
shrink = StakePubKey -> [StakePubKey]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary StakePubKeyHash where
    arbitrary :: Gen StakePubKeyHash
arbitrary = Gen StakePubKeyHash
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: StakePubKeyHash -> [StakePubKeyHash]
shrink = StakePubKeyHash -> [StakePubKeyHash]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Slot where
    arbitrary :: Gen Slot
arbitrary = Gen Slot
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Slot -> [Slot]
shrink = Slot -> [Slot]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PV2.TxId where
    arbitrary :: Gen TxId
arbitrary = Gen TxId
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: TxId -> [TxId]
shrink = TxId -> [TxId]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Signature where
    arbitrary :: Gen Signature
arbitrary = Gen Signature
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Signature -> [Signature]
shrink = Signature -> [Signature]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary ThreadToken where
    arbitrary :: Gen ThreadToken
arbitrary = Gen ThreadToken
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: ThreadToken -> [ThreadToken]
shrink = ThreadToken -> [ThreadToken]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PlutusTx.Data where
    arbitrary :: Gen Data
arbitrary = (Int -> Gen Data) -> Gen Data
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Data
arbitraryData
      where
        arbitraryData :: Int -> Gen PlutusTx.Data
        arbitraryData :: Int -> Gen Data
arbitraryData Int
n =
            [Gen Data] -> Gen Data
forall a. [Gen a] -> Gen a
oneof [ Int -> Gen Data
arbitraryConstr Int
n
                  , Int -> Gen Data
arbitraryMap Int
n
                  , Int -> Gen Data
arbitraryList Int
n
                  , Gen Data
arbitraryI
                  , Gen Data
arbitraryB
                  ]

        arbitraryConstr :: Int -> Gen Data
arbitraryConstr Int
n = do
          (Int
n', Int
m) <- Int -> Gen (Int, Int)
forall b. (Arbitrary b, Integral b) => b -> Gen (b, b)
segmentRange (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          (Positive Integer
ix) <- Gen (Positive Integer)
forall a. Arbitrary a => Gen a
arbitrary
          [Data]
args <- Int -> Gen Data -> Gen [Data]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
m (Int -> Gen Data
arbitraryData Int
n')
          Data -> Gen Data
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data -> Gen Data) -> Data -> Gen Data
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
PlutusTx.Constr Integer
ix [Data]
args

        arbitraryMap :: Int -> Gen Data
arbitraryMap Int
n = do
           -- NOTE: A pair always has at least 2 constructors/nodes so we divide by 2
          (Int
n', Int
m) <- Int -> Gen (Int, Int)
forall b. (Arbitrary b, Integral b) => b -> Gen (b, b)
segmentRange ((Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
          [(Data, Data)] -> Data
PlutusTx.Map ([(Data, Data)] -> Data) -> Gen [(Data, Data)] -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Data, Data) -> Gen [(Data, Data)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
m (Int -> Gen (Data, Data)
arbitraryPair Int
n')

        arbitraryPair :: Int -> Gen (Data, Data)
arbitraryPair Int
n = do
          (,) (Data -> Data -> (Data, Data))
-> Gen Data -> Gen (Data -> (Data, Data))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Data
arbitraryData Int
half Gen (Data -> (Data, Data)) -> Gen Data -> Gen (Data, Data)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Data
arbitraryData Int
half
          where
            half :: Int
half = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

        arbitraryList :: Int -> Gen Data
arbitraryList Int
n = do
          (Int
n', Int
m) <- Int -> Gen (Int, Int)
forall b. (Arbitrary b, Integral b) => b -> Gen (b, b)
segmentRange (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          [Data] -> Data
PlutusTx.List ([Data] -> Data) -> Gen [Data] -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Data -> Gen [Data]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
m (Int -> Gen Data
arbitraryData Int
n')

        arbitraryI :: Gen Data
arbitraryI =
          Integer -> Data
PlutusTx.I (Integer -> Data) -> Gen Integer -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary

        arbitraryB :: Gen Data
arbitraryB =
          ByteString -> Data
PlutusTx.B (ByteString -> Data) -> Gen ByteString -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary

        -- Used to break the sized generator up more or less evenly
        segmentRange :: b -> Gen (b, b)
segmentRange b
n = do
          (Positive b
m) <- Gen (Positive b)
forall a. Arbitrary a => Gen a
arbitrary
          let n' :: b
n' = b
n b -> b -> b
forall a. Integral a => a -> a -> a
`div` (b
m b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) -- Prevent division by 0
          (b, b) -> Gen (b, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
n', if b
n' b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 then b
m else b
0) -- Prevent segments of 0

    shrink :: Data -> [Data]
shrink = Data -> [Data]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PlutusTx.BuiltinData where
    arbitrary :: Gen BuiltinData
arbitrary = Data -> BuiltinData
PlutusTx.dataToBuiltinData (Data -> BuiltinData) -> Gen Data -> Gen BuiltinData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Data
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: BuiltinData -> [BuiltinData]
shrink BuiltinData
d = Data -> BuiltinData
PlutusTx.dataToBuiltinData (Data -> BuiltinData) -> [Data] -> [BuiltinData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data -> [Data]
forall a. Arbitrary a => a -> [a]
shrink (BuiltinData -> Data
PlutusTx.builtinDataToData BuiltinData
d)

instance Arbitrary Ledger.Language where
    arbitrary :: Gen Language
arbitrary = Gen Language
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Language -> [Language]
shrink = Language -> [Language]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (Arg (Ledger.Versioned script) script, Arbitrary script) => Arbitrary (Ledger.Versioned script) where
    arbitrary :: Gen (Versioned script)
arbitrary = Gen (Versioned script)
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Versioned script -> [Versioned script]
shrink = Versioned script -> [Versioned script]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Ledger.Datum where
    arbitrary :: Gen Datum
arbitrary = Gen Datum
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Datum -> [Datum]
shrink = Datum -> [Datum]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Ledger.DatumHash where
    arbitrary :: Gen DatumHash
arbitrary = Gen DatumHash
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: DatumHash -> [DatumHash]
shrink = DatumHash -> [DatumHash]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Ledger.Redeemer where
    arbitrary :: Gen Redeemer
arbitrary = Gen Redeemer
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Redeemer -> [Redeemer]
shrink = Redeemer -> [Redeemer]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Ledger.Validator where
    arbitrary :: Gen Validator
arbitrary = Validator -> Gen Validator
forall (f :: * -> *) a. Applicative f => a -> f a
pure Validator
acceptingValidator

instance Arbitrary Plutus.TokenName where
    arbitrary :: Gen TokenName
arbitrary = Gen TokenName
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: TokenName -> [TokenName]
shrink = TokenName -> [TokenName]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Plutus.CurrencySymbol where
    arbitrary :: Gen CurrencySymbol
arbitrary = Gen CurrencySymbol
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: CurrencySymbol -> [CurrencySymbol]
shrink = CurrencySymbol -> [CurrencySymbol]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Plutus.Ada where
    arbitrary :: Gen Ada
arbitrary = Gen Ada
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Ada -> [Ada]
shrink = Ada -> [Ada]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary C.Lovelace where
    arbitrary :: Gen Lovelace
arbitrary = Gen Lovelace
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Lovelace -> [Lovelace]
shrink = Lovelace -> [Lovelace]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Plutus.Value where
    arbitrary :: Gen Value
arbitrary = Gen Value
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Value -> [Value]
shrink = Value -> [Value]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary C.Value where
    arbitrary :: Gen Value
arbitrary = [(AssetId, Quantity)] -> Value
C.valueFromList ([(AssetId, Quantity)] -> Value)
-> Gen [(AssetId, Quantity)] -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [(AssetId, Quantity)]
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary C.AssetId where
    arbitrary :: Gen AssetId
arbitrary = Gen AssetId
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: AssetId -> [AssetId]
shrink = AssetId -> [AssetId]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary C.AssetName where
    arbitrary :: Gen AssetName
arbitrary = ByteString -> AssetName
C.AssetName (ByteString -> AssetName) -> Gen ByteString -> Gen AssetName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary C.Quantity where
    arbitrary :: Gen Quantity
arbitrary = Gen Quantity
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: Quantity -> [Quantity]
shrink = Quantity -> [Quantity]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary C.PolicyId where
    arbitrary :: Gen PolicyId
arbitrary = PolicyId -> Gen PolicyId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyId -> Gen PolicyId) -> PolicyId -> Gen PolicyId
forall a b. (a -> b) -> a -> b
$ Versioned MintingPolicy -> PolicyId
policyId (MintingPolicy -> Language -> Versioned MintingPolicy
forall script. script -> Language -> Versioned script
Versioned MintingPolicy
acceptingMintingPolicy Language
PlutusV1)

instance Arbitrary C.TxIx where
    arbitrary :: Gen TxIx
arbitrary = Gen TxIx
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary
    shrink :: TxIx -> [TxIx]
shrink = TxIx -> [TxIx]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (Arbitrary k, Arbitrary v) => Arbitrary (AssocMap.Map k v) where
    arbitrary :: Gen (Map k v)
arbitrary = [(k, v)] -> Map k v
forall k v. [(k, v)] -> Map k v
AssocMap.fromList ([(k, v)] -> Map k v) -> Gen [(k, v)] -> Gen (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [(k, v)]
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PABReq where
    arbitrary :: Gen PABReq
arbitrary =
        [Gen PABReq] -> Gen PABReq
forall a. [Gen a] -> Gen a
oneof
            [ Slot -> PABReq
AwaitSlotReq (Slot -> PABReq) -> Gen Slot -> Gen PABReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Slot
forall a. Arbitrary a => Gen a
arbitrary
            , PABReq -> Gen PABReq
forall (f :: * -> *) a. Applicative f => a -> f a
pure PABReq
CurrentNodeClientSlotReq
            , PABReq -> Gen PABReq
forall (f :: * -> *) a. Applicative f => a -> f a
pure PABReq
CurrentChainIndexSlotReq
            , PABReq -> Gen PABReq
forall (f :: * -> *) a. Applicative f => a -> f a
pure PABReq
OwnContractInstanceIdReq
            , ActiveEndpoint -> PABReq
ExposeEndpointReq (ActiveEndpoint -> PABReq) -> Gen ActiveEndpoint -> Gen PABReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ActiveEndpoint
forall a. Arbitrary a => Gen a
arbitrary
            , PABReq -> Gen PABReq
forall (f :: * -> *) a. Applicative f => a -> f a
pure PABReq
OwnAddressesReq
            -- TODO This would need an Arbitrary Tx instance:
            -- , BalanceTxRequest <$> arbitrary
            -- , WriteBalancedTxRequest <$> arbitrary
            ]

instance Arbitrary Address where
    arbitrary :: Gen Address
arbitrary = [Gen Address] -> Gen Address
forall a. [Gen a] -> Gen a
oneof [PaymentPubKey -> Maybe StakingCredential -> Address
Ledger.pubKeyAddress (PaymentPubKey -> Maybe StakingCredential -> Address)
-> Gen PaymentPubKey -> Gen (Maybe StakingCredential -> Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PaymentPubKey
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe StakingCredential -> Address)
-> Gen (Maybe StakingCredential) -> Gen Address
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe StakingCredential)
forall a. Arbitrary a => Gen a
arbitrary, Validator -> Address
mkValidatorAddress (Validator -> Address) -> Gen Validator -> Gen Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Validator
forall a. Arbitrary a => Gen a
arbitrary]

instance Arbitrary (C.AddressInEra C.BabbageEra) where
    arbitrary :: Gen (AddressInEra BabbageEra)
arbitrary = (Address -> Either ToCardanoError (AddressInEra BabbageEra))
-> Gen Address
-> Gen (Either ToCardanoError (AddressInEra BabbageEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NetworkId
-> Address -> Either ToCardanoError (AddressInEra BabbageEra)
toCardanoAddressInEra NetworkId
testnet) Gen Address
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary Gen (Either ToCardanoError (AddressInEra BabbageEra))
-> (Either ToCardanoError (AddressInEra BabbageEra)
    -> Maybe (AddressInEra BabbageEra))
-> Gen (AddressInEra BabbageEra)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` Either ToCardanoError (AddressInEra BabbageEra)
-> Maybe (AddressInEra BabbageEra)
forall a b. Either a b -> Maybe b
rightToMaybe

instance Arbitrary ValidatorHash where
    arbitrary :: Gen ValidatorHash
arbitrary = BuiltinByteString -> ValidatorHash
ValidatorHash (BuiltinByteString -> ValidatorHash)
-> Gen BuiltinByteString -> Gen ValidatorHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen BuiltinByteString
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary EndpointDescription where
    arbitrary :: Gen EndpointDescription
arbitrary = String -> EndpointDescription
EndpointDescription (String -> EndpointDescription)
-> Gen String -> Gen EndpointDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary ActiveEndpoint where
    arbitrary :: Gen ActiveEndpoint
arbitrary = EndpointDescription -> Maybe Value -> ActiveEndpoint
ActiveEndpoint (EndpointDescription -> Maybe Value -> ActiveEndpoint)
-> (String -> EndpointDescription)
-> String
-> Maybe Value
-> ActiveEndpoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EndpointDescription
EndpointDescription (String -> Maybe Value -> ActiveEndpoint)
-> Gen String -> Gen (Maybe Value -> ActiveEndpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe Value -> ActiveEndpoint)
-> Gen (Maybe Value) -> Gen ActiveEndpoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Value)
forall a. Arbitrary a => Gen a
arbitrary

-- Maintainer's note: These requests are deliberately excluded - some
-- problem with the arbitrary instances for the responses never
-- terminating.
--
-- Since we're not going to keep this code for long, I won't worry
-- about fixing it, but I'll leave the offending data there as a
-- warning sign around the rabbit hole:
-- bad :: [Gen ContractRequest]
-- bad =
--     [ BalanceTxRequest <$> arbitrary
--     , WriteBalancedTxRequest <$> arbitrary
--     ]

-- | Generate responses for mock requests. This function returns a
-- 'Maybe' because we can't (yet) create a generator for every request
-- type.
genResponse :: PABReq -> Maybe (Gen PABResp)
genResponse :: PABReq -> Maybe (Gen PABResp)
genResponse (AwaitSlotReq Slot
slot)   = Gen PABResp -> Maybe (Gen PABResp)
forall a. a -> Maybe a
Just (Gen PABResp -> Maybe (Gen PABResp))
-> (Slot -> Gen PABResp) -> Slot -> Maybe (Gen PABResp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PABResp -> Gen PABResp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PABResp -> Gen PABResp)
-> (Slot -> PABResp) -> Slot -> Gen PABResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> PABResp
AwaitSlotResp (Slot -> Maybe (Gen PABResp)) -> Slot -> Maybe (Gen PABResp)
forall a b. (a -> b) -> a -> b
$ Slot
slot
genResponse (ExposeEndpointReq ActiveEndpoint
_) = Gen PABResp -> Maybe (Gen PABResp)
forall a. a -> Maybe a
Just (Gen PABResp -> Maybe (Gen PABResp))
-> Gen PABResp -> Maybe (Gen PABResp)
forall a b. (a -> b) -> a -> b
$ EndpointDescription -> EndpointValue Value -> PABResp
ExposeEndpointResp (EndpointDescription -> EndpointValue Value -> PABResp)
-> Gen EndpointDescription -> Gen (EndpointValue Value -> PABResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EndpointDescription
forall a. Arbitrary a => Gen a
arbitrary Gen (EndpointValue Value -> PABResp)
-> Gen (EndpointValue Value) -> Gen PABResp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> EndpointValue Value
forall a. a -> EndpointValue a
EndpointValue (Value -> EndpointValue Value)
-> Gen Value -> Gen (EndpointValue Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Value
forall a. Arbitrary a => Gen a
arbitrary)
genResponse PABReq
OwnAddressesReq       = Gen PABResp -> Maybe (Gen PABResp)
forall a. a -> Maybe a
Just (Gen PABResp -> Maybe (Gen PABResp))
-> Gen PABResp -> Maybe (Gen PABResp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (AddressInEra BabbageEra) -> PABResp
OwnAddressesResp (NonEmpty (AddressInEra BabbageEra) -> PABResp)
-> Gen (NonEmpty (AddressInEra BabbageEra)) -> Gen PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonEmpty (AddressInEra BabbageEra))
forall a. Arbitrary a => Gen a
arbitrary
genResponse PABReq
_                     = Maybe (Gen PABResp)
forall a. Maybe a
Nothing