{-# 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.Tx (AlonzoTxBody (..))
import Cardano.Ledger.Alonzo.TxAuxData (AuxiliaryDataHash)
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (EncCBOR (..))
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (KeyHash)
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 = forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

instance Twiddle SlotNo where
  twiddle :: Version -> SlotNo -> Gen Term
twiddle Version
v = forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Twiddle a => Version -> a -> Gen Term
twiddle Version
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> Term
toTerm Version
v

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

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

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

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

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

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

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

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

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

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

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

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

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