{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

module Test.Cardano.Ledger.Examples.AlonzoAPI (tests) where

import Cardano.Ledger.Alonzo.Tx (alonzoMinFeeTx)
import Cardano.Ledger.BaseTypes (ProtVer (..), inject, natVersion)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Plutus (ExUnits (..))
import Cardano.Ledger.Plutus.Data (Data (..))
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Tools (estimateMinFeeTx)
import qualified PlutusLedgerApi.V1 as PV1
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessVKey)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  mkGenesisTxIn,
  mkSingleRedeemer,
  mkTxDats,
  someAddr,
  someKeys,
 )
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxField (..),
  TxOutField (..),
  WitnessesField (..),
 )
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..))
import Test.Cardano.Ledger.Generic.PrettyCore ()
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Generic.Scriptic (Scriptic (..))
import Test.Cardano.Ledger.Generic.Updaters
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Alonzo API" [TestName -> Assertion -> TestTree
testCase TestName
"estimateMinFee" Assertion
testEstimateMinFee]

testEstimateMinFee :: Assertion
testEstimateMinFee :: Assertion
testEstimateMinFee =
  forall era.
EraTx era =>
PParams era -> Tx era -> Int -> Int -> Int -> Coin
estimateMinFeeTx @AlonzoEra
    PParams AlonzoEra
pparams
    Tx AlonzoEra
AlonzoTx AlonzoEra
validatingTxNoWits
    Int
1
    Int
0
    Int
0
    Coin -> Coin -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= PParams AlonzoEra -> Tx AlonzoEra -> Coin
forall era.
(EraTx era, AlonzoEraTxWits era, AlonzoEraPParams era) =>
PParams era -> Tx era -> Coin
alonzoMinFeeTx PParams AlonzoEra
pparams Tx AlonzoEra
AlonzoTx AlonzoEra
validatingTx
  where
    pf :: Proof AlonzoEra
pf = Proof AlonzoEra
Alonzo
    pparams :: PParams AlonzoEra
pparams = Proof AlonzoEra -> [PParamsField AlonzoEra] -> PParams AlonzoEra
forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof AlonzoEra
pf ([PParamsField AlonzoEra] -> PParams AlonzoEra)
-> [PParamsField AlonzoEra] -> PParams AlonzoEra
forall a b. (a -> b) -> a -> b
$ [PParamsField AlonzoEra]
forall era. [PParamsField era]
defaultPPs [PParamsField AlonzoEra]
-> [PParamsField AlonzoEra] -> [PParamsField AlonzoEra]
forall a. [a] -> [a] -> [a]
++ [Coin -> PParamsField AlonzoEra
forall era. Coin -> PParamsField era
MinfeeA (Integer -> Coin
Coin Integer
1)]
    validatingTxNoWits :: Tx AlonzoEra
validatingTxNoWits =
      Proof AlonzoEra -> [TxField AlonzoEra] -> Tx AlonzoEra
forall era. Proof era -> [TxField era] -> Tx era
newTx
        Proof AlonzoEra
pf
        [ TxBody AlonzoEra -> TxField AlonzoEra
forall era. TxBody era -> TxField era
Body TxBody AlonzoEra
validatingBody
        , [WitnessesField AlonzoEra] -> TxField AlonzoEra
forall era. [WitnessesField era] -> TxField era
WitnessesI
            [ [Script AlonzoEra] -> WitnessesField AlonzoEra
forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [Natural -> Proof AlonzoEra -> Script AlonzoEra
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof AlonzoEra
pf]
            , [Data AlonzoEra] -> WitnessesField AlonzoEra
forall era. Era era => [Data era] -> WitnessesField era
DataWits' [Data -> Data AlonzoEra
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)]
            , Redeemers AlonzoEra -> WitnessesField AlonzoEra
forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers AlonzoEra
redeemers
            ]
        ]
    validatingTx :: Tx AlonzoEra
validatingTx =
      Proof AlonzoEra -> [TxField AlonzoEra] -> Tx AlonzoEra
forall era. Proof era -> [TxField era] -> Tx era
newTx
        Proof AlonzoEra
pf
        [ TxBody AlonzoEra -> TxField AlonzoEra
forall era. TxBody era -> TxField era
Body TxBody AlonzoEra
validatingBody
        , [WitnessesField AlonzoEra] -> TxField AlonzoEra
forall era. [WitnessesField era] -> TxField era
WitnessesI
            [ [WitVKey 'Witness] -> WitnessesField AlonzoEra
forall era. Era era => [WitVKey 'Witness] -> WitnessesField era
AddrWits' [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody AlonzoEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody AlonzoEra
validatingBody) (Proof AlonzoEra -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof AlonzoEra
pf)]
            , [Script AlonzoEra] -> WitnessesField AlonzoEra
forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [Natural -> Proof AlonzoEra -> Script AlonzoEra
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof AlonzoEra
pf]
            , [Data AlonzoEra] -> WitnessesField AlonzoEra
forall era. Era era => [Data era] -> WitnessesField era
DataWits' [Data -> Data AlonzoEra
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)]
            , Redeemers AlonzoEra -> WitnessesField AlonzoEra
forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers AlonzoEra
redeemers
            ]
        ]
    validatingBody :: TxBody AlonzoEra
validatingBody =
      Proof AlonzoEra -> [TxBodyField AlonzoEra] -> TxBody AlonzoEra
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof AlonzoEra
pf
        [ [TxIn] -> TxBodyField AlonzoEra
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1]
        , [TxIn] -> TxBodyField AlonzoEra
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
11]
        , [TxOut AlonzoEra] -> TxBodyField AlonzoEra
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof AlonzoEra -> [TxOutField AlonzoEra] -> TxOut AlonzoEra
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof AlonzoEra
pf [Addr -> TxOutField AlonzoEra
forall era. Addr -> TxOutField era
Address (Proof AlonzoEra -> Addr
forall era. Proof era -> Addr
someAddr Proof AlonzoEra
pf), Value AlonzoEra -> TxOutField AlonzoEra
forall era. Value era -> TxOutField era
Amount (Coin -> Value AlonzoEra
forall t s. Inject t s => t -> s
inject (Coin -> Value AlonzoEra) -> Coin -> Value AlonzoEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
        , Coin -> TxBodyField AlonzoEra
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
316)
        , StrictMaybe ScriptIntegrityHash -> TxBodyField AlonzoEra
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash
            ( Proof AlonzoEra
-> PParams AlonzoEra
-> [Language]
-> Redeemers AlonzoEra
-> TxDats AlonzoEra
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash
                Proof AlonzoEra
pf
                (Proof AlonzoEra -> [PParamsField AlonzoEra] -> PParams AlonzoEra
forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof AlonzoEra
pf [PParamsField AlonzoEra]
forall era. [PParamsField era]
defaultPPs)
                [Language
PlutusV1]
                Redeemers AlonzoEra
redeemers
                (Data AlonzoEra -> TxDats AlonzoEra
forall era. Era era => Data era -> TxDats era
mkTxDats (Data -> Data AlonzoEra
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)))
            )
        ]
    redeemers :: Redeemers AlonzoEra
redeemers = Proof AlonzoEra
-> PlutusPurposeTag -> Data AlonzoEra -> Redeemers AlonzoEra
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof AlonzoEra
pf PlutusPurposeTag
Spending (Data -> Data AlonzoEra
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

defaultPPs :: [PParamsField era]
defaultPPs :: forall era. [PParamsField era]
defaultPPs =
  [ CostModels -> PParamsField era
forall era. CostModels -> PParamsField era
Costmdls (CostModels -> PParamsField era) -> CostModels -> PParamsField era
forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
  , Natural -> PParamsField era
forall era. Natural -> PParamsField era
MaxValSize Natural
1000000000
  , ExUnits -> PParamsField era
forall era. ExUnits -> PParamsField era
MaxTxExUnits (ExUnits -> PParamsField era) -> ExUnits -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , ExUnits -> PParamsField era
forall era. ExUnits -> PParamsField era
MaxBlockExUnits (ExUnits -> PParamsField era) -> ExUnits -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , ProtVer -> PParamsField era
forall era. ProtVer -> PParamsField era
ProtocolVersion (ProtVer -> PParamsField era) -> ProtVer -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @5) Natural
0
  , Natural -> PParamsField era
forall era. Natural -> PParamsField era
CollateralPercentage Natural
100
  ]