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

module Test.Cardano.Ledger.Alonzo.Binary.Twiddle () 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 Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Binary.Twiddle
import Test.Cardano.Ledger.Common

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 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 TopTx AlonzoEra) where
  twiddle :: Version -> TxBody TopTx AlonzoEra -> Gen Term
twiddle Version
v TxBody TopTx AlonzoEra
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 AlonzoEra -> Set TxIn
atbInputs TxBody TopTx AlonzoEra
txBody
    outputs' <- twiddle v $ atbOutputs txBody
    fee' <- twiddle v $ atbTxFee txBody
    -- Empty collateral can be represented by empty set or the
    -- value can be omitted entirely
    ttl' <- twiddleStrictMaybe v . invalidHereafter $ atbValidityInterval txBody
    cert' <- emptyOrNothing v $ atbCerts txBody
    withdrawals' <- twiddle v $ atbWithdrawals txBody
    update' <- twiddleStrictMaybe v $ atbUpdate txBody
    auxDataHash' <- twiddleStrictMaybe v $ atbAuxDataHash txBody
    validityStart' <- twiddleStrictMaybe v . invalidBefore $ atbValidityInterval txBody
    mint' <- twiddle v $ atbMint txBody
    scriptDataHash' <- twiddleStrictMaybe v $ atbScriptIntegrityHash txBody
    collateral' <- emptyOrNothing v $ atbCollateral txBody
    requiredSigners' <- emptyOrNothing v $ atbReqSignerHashes txBody
    networkId' <- twiddleStrictMaybe v $ atbTxNetworkId 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'
              ]
    fields' <- shuffle fields
    pure $ mp 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