{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Alonzo.Serialisation.Generators where

import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..), TxBody (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (EncCBOR (..))
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Mary.Value (MultiAsset)
import Cardano.Ledger.Plutus.Data (BinaryData, Data (..))
import Cardano.Ledger.Shelley.PParams (Update)
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert)
import Cardano.Ledger.TxIn (TxIn)
import Cardano.Ledger.Val (Val)
import Codec.CBOR.Term (Term (..))
import Data.Maybe (catMaybes)
import Data.Typeable (Typeable)
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Binary.Twiddle
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.QuickCheck

instance (Era era, Val (Value era)) => Twiddle (AlonzoTxOut era) where
  twiddle :: Version -> AlonzoTxOut era -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (AlonzoTxOut era -> Term) -> AlonzoTxOut era -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> AlonzoTxOut era -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle SlotNo where
  twiddle :: Version -> SlotNo -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term) -> (SlotNo -> Term) -> SlotNo -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> SlotNo -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Era era => Twiddle (ShelleyTxCert era) where
  twiddle :: Version -> ShelleyTxCert era -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (ShelleyTxCert era -> Term) -> ShelleyTxCert era -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> ShelleyTxCert era -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle Withdrawals where
  twiddle :: Version -> Withdrawals -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (Withdrawals -> Term) -> Withdrawals -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Withdrawals -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle TxAuxDataHash where
  twiddle :: Version -> TxAuxDataHash -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (TxAuxDataHash -> Term) -> TxAuxDataHash -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> TxAuxDataHash -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle (Update AlonzoEra) where
  twiddle :: Version -> Update AlonzoEra -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (Update AlonzoEra -> Term) -> Update AlonzoEra -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Update AlonzoEra -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle MultiAsset where
  twiddle :: Version -> MultiAsset -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (MultiAsset -> Term) -> MultiAsset -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> Term
encodingToTerm Version
v (Encoding -> Term)
-> (MultiAsset -> Encoding) -> MultiAsset -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiAsset -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR

instance Twiddle ScriptIntegrityHash where
  twiddle :: Version -> ScriptIntegrityHash -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (ScriptIntegrityHash -> Term) -> ScriptIntegrityHash -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> ScriptIntegrityHash -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Typeable t => Twiddle (KeyHash t) where
  twiddle :: Version -> KeyHash t -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term) -> (KeyHash t -> Term) -> KeyHash t -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> KeyHash t -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle Network where
  twiddle :: Version -> Network -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term) -> (Network -> Term) -> Network -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Network -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle TxIn where
  twiddle :: Version -> TxIn -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term) -> (TxIn -> Term) -> TxIn -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> TxIn -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle Coin where
  twiddle :: Version -> Coin -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term) -> (Coin -> Term) -> Coin -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Coin -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle (TxBody AlonzoEra) where
  twiddle :: Version -> TxBody AlonzoEra -> Gen Term
twiddle Version
v TxBody AlonzoEra
txBody = do
    Term
inputs' <- Version -> Set TxIn -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Set TxIn -> Gen Term) -> Set TxIn -> Gen Term
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> Set TxIn
atbInputs TxBody AlonzoEra
txBody
    Term
outputs' <- Version -> StrictSeq (TxOut AlonzoEra) -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (StrictSeq (TxOut AlonzoEra) -> Gen Term)
-> StrictSeq (TxOut AlonzoEra) -> Gen Term
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> StrictSeq (TxOut AlonzoEra)
atbOutputs TxBody AlonzoEra
txBody
    Term
fee' <- Version -> Coin -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Coin -> Gen Term) -> Coin -> Gen Term
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> Coin
atbTxFee TxBody AlonzoEra
txBody
    -- Empty collateral can be represented by empty set or the
    -- value can be omitted entirely
    Maybe Term
ttl' <- Version -> StrictMaybe SlotNo -> Gen (Maybe Term)
forall a. Twiddle a => Version -> StrictMaybe a -> Gen (Maybe Term)
twiddleStrictMaybe Version
v (StrictMaybe SlotNo -> Gen (Maybe Term))
-> (ValidityInterval -> StrictMaybe SlotNo)
-> ValidityInterval
-> Gen (Maybe Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidityInterval -> StrictMaybe SlotNo
invalidHereafter (ValidityInterval -> Gen (Maybe Term))
-> ValidityInterval -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> ValidityInterval
atbValidityInterval TxBody AlonzoEra
txBody
    Maybe Term
cert' <- Version -> StrictSeq (TxCert AlonzoEra) -> Gen (Maybe Term)
forall (t :: * -> *) b.
(Foldable t, Twiddle (t Void), Monoid (t Void), Twiddle (t b)) =>
Version -> t b -> Gen (Maybe Term)
emptyOrNothing Version
v (StrictSeq (TxCert AlonzoEra) -> Gen (Maybe Term))
-> StrictSeq (TxCert AlonzoEra) -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> StrictSeq (TxCert AlonzoEra)
atbCerts TxBody AlonzoEra
txBody
    Term
withdrawals' <- Version -> Withdrawals -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Withdrawals -> Gen Term) -> Withdrawals -> Gen Term
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> Withdrawals
atbWithdrawals TxBody AlonzoEra
txBody
    Maybe Term
update' <- Version -> StrictMaybe (Update AlonzoEra) -> Gen (Maybe Term)
forall a. Twiddle a => Version -> StrictMaybe a -> Gen (Maybe Term)
twiddleStrictMaybe Version
v (StrictMaybe (Update AlonzoEra) -> Gen (Maybe Term))
-> StrictMaybe (Update AlonzoEra) -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> StrictMaybe (Update AlonzoEra)
atbUpdate TxBody AlonzoEra
txBody
    Maybe Term
auxDataHash' <- Version -> StrictMaybe TxAuxDataHash -> Gen (Maybe Term)
forall a. Twiddle a => Version -> StrictMaybe a -> Gen (Maybe Term)
twiddleStrictMaybe Version
v (StrictMaybe TxAuxDataHash -> Gen (Maybe Term))
-> StrictMaybe TxAuxDataHash -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> StrictMaybe TxAuxDataHash
atbAuxDataHash TxBody AlonzoEra
txBody
    Maybe Term
validityStart' <- Version -> StrictMaybe SlotNo -> Gen (Maybe Term)
forall a. Twiddle a => Version -> StrictMaybe a -> Gen (Maybe Term)
twiddleStrictMaybe Version
v (StrictMaybe SlotNo -> Gen (Maybe Term))
-> (ValidityInterval -> StrictMaybe SlotNo)
-> ValidityInterval
-> Gen (Maybe Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidityInterval -> StrictMaybe SlotNo
invalidBefore (ValidityInterval -> Gen (Maybe Term))
-> ValidityInterval -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> ValidityInterval
atbValidityInterval TxBody AlonzoEra
txBody
    Term
mint' <- Version -> MultiAsset -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (MultiAsset -> Gen Term) -> MultiAsset -> Gen Term
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> MultiAsset
atbMint TxBody AlonzoEra
txBody
    Maybe Term
scriptDataHash' <- Version -> StrictMaybe ScriptIntegrityHash -> Gen (Maybe Term)
forall a. Twiddle a => Version -> StrictMaybe a -> Gen (Maybe Term)
twiddleStrictMaybe Version
v (StrictMaybe ScriptIntegrityHash -> Gen (Maybe Term))
-> StrictMaybe ScriptIntegrityHash -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> StrictMaybe ScriptIntegrityHash
atbScriptIntegrityHash TxBody AlonzoEra
txBody
    Maybe Term
collateral' <- Version -> Set TxIn -> Gen (Maybe Term)
forall (t :: * -> *) b.
(Foldable t, Twiddle (t Void), Monoid (t Void), Twiddle (t b)) =>
Version -> t b -> Gen (Maybe Term)
emptyOrNothing Version
v (Set TxIn -> Gen (Maybe Term)) -> Set TxIn -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> Set TxIn
atbCollateral TxBody AlonzoEra
txBody
    Maybe Term
requiredSigners' <- Version -> Set (KeyHash 'Witness) -> Gen (Maybe Term)
forall (t :: * -> *) b.
(Foldable t, Twiddle (t Void), Monoid (t Void), Twiddle (t b)) =>
Version -> t b -> Gen (Maybe Term)
emptyOrNothing Version
v (Set (KeyHash 'Witness) -> Gen (Maybe Term))
-> Set (KeyHash 'Witness) -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> Set (KeyHash 'Witness)
atbReqSignerHashes TxBody AlonzoEra
txBody
    Maybe Term
networkId' <- Version -> StrictMaybe Network -> Gen (Maybe Term)
forall a. Twiddle a => Version -> StrictMaybe a -> Gen (Maybe Term)
twiddleStrictMaybe Version
v (StrictMaybe Network -> Gen (Maybe Term))
-> StrictMaybe Network -> Gen (Maybe Term)
forall a b. (a -> b) -> a -> b
$ TxBody AlonzoEra -> StrictMaybe Network
atbTxNetworkId TxBody AlonzoEra
txBody
    [(Term, Term)] -> Term
mp <- [[(Term, Term)] -> Term] -> Gen ([(Term, Term)] -> Term)
forall a. HasCallStack => [a] -> Gen a
elements [[(Term, Term)] -> Term
TMap, [(Term, Term)] -> Term
TMapI]
    let fields :: [(Term, Term)]
fields =
          [ (Int -> Term
TInt Int
0, Term
inputs')
          , (Int -> Term
TInt Int
1, Term
outputs')
          , (Int -> Term
TInt Int
2, Term
fee')
          ]
            [(Term, Term)] -> [(Term, Term)] -> [(Term, Term)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Term, Term)] -> [(Term, Term)]
forall a. [Maybe a] -> [a]
catMaybes
              [ (Int -> Term
TInt Int
3,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
ttl'
              , (Int -> Term
TInt Int
4,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
cert'
              , (Int -> Term
TInt Int
5,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe Term
forall a. a -> Maybe a
Just Term
withdrawals'
              , (Int -> Term
TInt Int
6,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
update'
              , (Int -> Term
TInt Int
7,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
auxDataHash'
              , (Int -> Term
TInt Int
8,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
validityStart'
              , (Int -> Term
TInt Int
9,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe Term
forall a. a -> Maybe a
Just Term
mint'
              , (Int -> Term
TInt Int
11,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
scriptDataHash'
              , (Int -> Term
TInt Int
13,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
collateral'
              , (Int -> Term
TInt Int
14,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
requiredSigners'
              , (Int -> Term
TInt Int
15,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
networkId'
              ]
    [(Term, Term)]
fields' <- [(Term, Term)] -> Gen [(Term, Term)]
forall a. [a] -> Gen [a]
shuffle [(Term, Term)]
fields
    Term -> Gen Term
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Gen Term) -> Term -> Gen Term
forall a b. (a -> b) -> a -> b
$ [(Term, Term)] -> Term
mp [(Term, Term)]
fields'

instance Twiddle (AlonzoScript AlonzoEra) where
  twiddle :: Version -> AlonzoScript AlonzoEra -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (AlonzoScript AlonzoEra -> Term)
-> AlonzoScript AlonzoEra
-> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> AlonzoScript AlonzoEra -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle (Data AlonzoEra) where
  twiddle :: Version -> Data AlonzoEra -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (Data AlonzoEra -> Term) -> Data AlonzoEra -> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Data AlonzoEra -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle (BinaryData AlonzoEra) where
  twiddle :: Version -> BinaryData AlonzoEra -> Gen Term
twiddle Version
v = Version -> Term -> Gen Term
forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v (Term -> Gen Term)
-> (BinaryData AlonzoEra -> Term)
-> BinaryData AlonzoEra
-> Gen Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> BinaryData AlonzoEra -> Term
forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v