{-# 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.TxBody (AlonzoTxOut (..))
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 = 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 Twiddle Withdrawals where
  twiddle :: Version -> Withdrawals -> 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 TxAuxDataHash where
  twiddle :: Version -> TxAuxDataHash -> 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 (Update AlonzoEra) where
  twiddle :: Version -> Update AlonzoEra -> 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 MultiAsset where
  twiddle :: Version -> MultiAsset -> 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 Twiddle ScriptIntegrityHash where
  twiddle :: Version -> ScriptIntegrityHash -> 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 t => Twiddle (KeyHash t) where
  twiddle :: Version -> KeyHash t -> 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 Twiddle TxIn where
  twiddle :: Version -> TxIn -> 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 Twiddle (AlonzoTxBody AlonzoEra) where
  twiddle :: Version -> AlonzoTxBody AlonzoEra -> Gen Term
twiddle Version
v AlonzoTxBody AlonzoEra
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
atbInputs AlonzoTxBody AlonzoEra
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
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
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
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
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
atbWithdrawals AlonzoTxBody AlonzoEra
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
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 TxAuxDataHash
atbAuxDataHash AlonzoTxBody AlonzoEra
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
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
atbMint AlonzoTxBody AlonzoEra
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
atbScriptIntegrityHash AlonzoTxBody AlonzoEra
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
atbCollateral AlonzoTxBody AlonzoEra
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)
atbReqSignerHashes AlonzoTxBody AlonzoEra
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
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 Twiddle (AlonzoScript AlonzoEra) where
  twiddle :: Version -> AlonzoScript AlonzoEra -> 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 (Data AlonzoEra) where
  twiddle :: Version -> Data AlonzoEra -> 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 (BinaryData AlonzoEra) where
  twiddle :: Version -> BinaryData AlonzoEra -> 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