{-# 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]

type A = AlonzoEra StandardCrypto

testEstimateMinFee :: Assertion
testEstimateMinFee :: Assertion
testEstimateMinFee =
  forall era.
EraTx era =>
PParams era -> Tx era -> Int -> Int -> Int -> Coin
estimateMinFeeTx @A
    PParams A
pparams
    AlonzoTx A
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 A
pparams AlonzoTx A
validatingTx
  where
    pf :: Proof A
pf = Proof A
Alonzo
    pparams :: PParams A
pparams = forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof A
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 A
validatingTxNoWits =
      forall era. Proof era -> [TxField era] -> Tx era
newTx
        Proof A
pf
        [ forall era. TxBody era -> TxField era
Body AlonzoTxBody A
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 A
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 A
redeemers
            ]
        ]
    validatingTx :: Tx A
validatingTx =
      forall era. Proof era -> [TxField era] -> Tx era
newTx
        Proof A
pf
        [ forall era. TxBody era -> TxField era
Body AlonzoTxBody A
validatingBody
        , forall era. [WitnessesField era] -> TxField era
WitnessesI
            [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated AlonzoTxBody A
validatingBody) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof A
pf)]
            , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof A
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 A
redeemers
            ]
        ]
    validatingBody :: TxBody A
validatingBody =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof A
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
1]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
11]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof A
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof A
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 (EraCrypto era))
-> TxBodyField era
WppHash
            ( forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash
                Proof A
pf
                (forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof A
pf forall era. [PParamsField era]
defaultPPs)
                [Language
PlutusV1]
                Redeemers A
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 A
redeemers = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof A
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
  ]