{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Babbage.Binary.Twiddle () where

import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.Tx
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
import Cardano.Ledger.Binary (Sized, Term (..))
import Cardano.Ledger.Shelley.PParams (Update (..))
import Cardano.Ledger.Val (Val)
import Data.Maybe (catMaybes)
import Test.Cardano.Ledger.Alonzo.Binary.Twiddle ()
import Test.Cardano.Ledger.Binary.Twiddle (Twiddle (..), emptyOrNothing, toTerm, twiddleStrictMaybe)
import Test.Cardano.Ledger.Common

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

instance Twiddle a => Twiddle (Sized a)

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

instance Twiddle (TxBody TopTx BabbageEra) where
  twiddle :: Version -> TxBody TopTx BabbageEra -> Gen Term
twiddle Version
v TxBody TopTx BabbageEra
txBody = do
    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 TopTx BabbageEra -> Set TxIn
btbInputs TxBody TopTx BabbageEra
txBody
    outputs' <- twiddle v $ btbOutputs txBody
    fee' <- twiddle v $ btbTxFee txBody
    -- Empty collateral can be represented by empty set or the
    -- value can be omitted entirely
    ttl' <- twiddleStrictMaybe v . invalidHereafter $ btbValidityInterval txBody
    cert' <- emptyOrNothing v $ btbCerts txBody
    withdrawals' <- twiddle v $ btbWithdrawals txBody
    update' <- twiddleStrictMaybe v $ btbUpdate txBody
    auxDataHash' <- twiddleStrictMaybe v $ btbAuxDataHash txBody
    validityStart' <- twiddleStrictMaybe v . invalidBefore $ btbValidityInterval txBody
    mint' <- twiddle v $ btbMint txBody
    scriptDataHash' <- twiddleStrictMaybe v $ btbScriptIntegrityHash txBody
    collateral' <- emptyOrNothing v $ btbCollateral txBody
    requiredSigners' <- emptyOrNothing v $ btbReqSignerHashes txBody
    networkId' <- twiddleStrictMaybe v $ btbTxNetworkId txBody
    collateralReturn <- twiddleStrictMaybe v $ btbCollateralReturn txBody
    totalCollateral <- twiddleStrictMaybe v $ btbTotalCollateral txBody
    referenceInputs <- emptyOrNothing v $ btbReferenceInputs txBody
    mp <- elements [TMap, TMapI]
    let 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'
              , (Int -> Term
TInt Int
16,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
collateralReturn
              , (Int -> Term
TInt Int
17,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
totalCollateral
              , (Int -> Term
TInt Int
18,) (Term -> (Term, Term)) -> Maybe Term -> Maybe (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Term
referenceInputs
              ]
    fields' <- shuffle fields
    pure $ mp fields'