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

defaultPPs :: [PParamsField era]
defaultPPs :: forall era. [PParamsField era]
defaultPPs =
  [ forall era. CostModels -> PParamsField era
Costmdls forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
  , forall era. Natural -> PParamsField era
MaxValSize Natural
1000000000
  , forall era. ExUnits -> PParamsField era
MaxTxExUnits forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , forall era. ExUnits -> PParamsField era
MaxBlockExUnits forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , forall era. ProtVer -> PParamsField era
ProtocolVersion 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
  , forall era. Natural -> PParamsField era
CollateralPercentage Natural
100
  ]