{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Test.Cardano.Ledger.Alonzo.Golden
-- Description : Golden Tests for the Alonzo era
module Test.Cardano.Ledger.Alonzo.Golden (
  tests,
)
where

import Cardano.Ledger.Alonzo (Alonzo)
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
import Cardano.Ledger.Alonzo.PParams (
  LangDepView (..),
  getLanguageView,
 )
import Cardano.Ledger.Alonzo.Rules (FailureDescription (..), TagMismatchDescription (..))
import Cardano.Ledger.Alonzo.Tx (IsValid (..), alonzoMinFeeTx)
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..), utxoEntrySize)
import Cardano.Ledger.BaseTypes (SlotNo (..), StrictMaybe (..), boundRational)
import Cardano.Ledger.Binary (decCBOR, decodeFullAnnotator)
import Cardano.Ledger.Binary.Plain as Plain (serialize)
import Cardano.Ledger.Block (Block (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Mary.Value (valueFromList)
import Cardano.Ledger.Plutus.CostModels (
  CostModel,
  CostModels,
  mkCostModel,
  mkCostModels,
 )
import Cardano.Ledger.Plutus.Data (Data (..), hashData)
import Cardano.Ledger.Plutus.ExUnits (
  ExUnits (..),
  Prices (..),
 )
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Protocol.TPraos.BHeader (BHeader)
import Data.Aeson (eitherDecodeFileStrict)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Base16.Lazy as B16L
import qualified Data.ByteString.Lazy as BSL
import Data.Either (fromRight)
import Data.Int
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import Data.Sequence.Strict
import GHC.Stack (HasCallStack)
import Lens.Micro
import Paths_cardano_ledger_alonzo_test
import qualified PlutusLedgerApi.V1 as PV1 (Data (..))
import Test.Cardano.Ledger.Alonzo.Examples.Consensus (ledgerExamplesAlonzo)
import Test.Cardano.Ledger.EraBuffet (StandardCrypto)
import Test.Cardano.Ledger.Mary.Golden (
  largestName,
  minUTxO,
  pid1,
  pid2,
  pid3,
  smallName,
  smallestName,
 )
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
import Test.Cardano.Ledger.Shelley.Examples.Cast (aliceAddr, bobAddr, carlAddr)
import qualified Test.Cardano.Ledger.Shelley.Examples.Consensus as SLE
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

readDataFile :: FilePath -> IO BSL.ByteString
readDataFile :: [Char] -> IO ByteString
readDataFile [Char]
name = [Char] -> IO [Char]
getDataFileName [Char]
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO ByteString
BSL.readFile

-- | ada cost of storing a word8 of data as a UTxO entry, assuming no change to minUTxOValue
coinsPerUTxOWordLocal :: Integer
coinsPerUTxOWordLocal :: Integer
coinsPerUTxOWordLocal = forall a. Integral a => a -> a -> a
quot Integer
minUTxOValueShelleyMA Integer
utxoEntrySizeWithoutValLocal
  where
    utxoEntrySizeWithoutValLocal :: Integer
utxoEntrySizeWithoutValLocal = Integer
29
    Coin Integer
minUTxOValueShelleyMA = Coin
minUTxO

calcMinUTxO :: AlonzoTxOut Alonzo -> Coin
calcMinUTxO :: AlonzoTxOut Alonzo -> Coin
calcMinUTxO AlonzoTxOut Alonzo
tout = Integer -> Coin
Coin (forall era. AlonzoEraTxOut era => TxOut era -> Integer
utxoEntrySize AlonzoTxOut Alonzo
tout forall a. Num a => a -> a -> a
* Integer
coinsPerUTxOWordLocal)

tests :: TestTree
tests :: TestTree
tests =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"Alonzo Golden Tests"
    [ TestTree
goldenCborSerialization
    , TestTree
goldenJsonSerialization
    , TestTree
goldenMinFee
    , TestTree
goldenScriptIntegrity
    , TestTree
goldenGenesisSerialization
    , TestTree
goldenUTxOEntryMinAda
    ]

-- | (heapWords of a DataHash) * coinsPerUTxOWordLocal is 344820
goldenUTxOEntryMinAda :: TestTree
goldenUTxOEntryMinAda :: TestTree
goldenUTxOEntryMinAda =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"golden tests - UTxOEntryMinAda"
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"one policy, one (smallest) name, yes datum hash" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
carlAddr
              (forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList (Integer -> Coin
Coin Integer
1407406) [(PolicyID StandardCrypto
pid1, AssetName
smallestName, Integer
1)])
              (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData @Alonzo (forall era. Era era => Data -> Data era
Data ([Data] -> Data
PV1.List [])))
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1655136
    , [Char] -> Assertion -> TestTree
testCase [Char]
"one policy, one (smallest) name, no datum hash" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
bobAddr
              (forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList (Integer -> Coin
Coin Integer
1407406) [(PolicyID StandardCrypto
pid1, AssetName
smallestName, Integer
1)])
              forall a. StrictMaybe a
SNothing
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1310316
    , [Char] -> Assertion -> TestTree
testCase [Char]
"one policy, one (small) name" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
aliceAddr
              (forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList (Integer -> Coin
Coin Integer
1444443) [(PolicyID StandardCrypto
pid1, Word8 -> AssetName
smallName Word8
1, Integer
1)])
              forall a. StrictMaybe a
SNothing
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1344798
    , [Char] -> Assertion -> TestTree
testCase [Char]
"one policy, three (small) names" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
aliceAddr
              ( forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList
                  (Integer -> Coin
Coin Integer
1555554)
                  [ (PolicyID StandardCrypto
pid1, Word8 -> AssetName
smallName Word8
1, Integer
1)
                  , (PolicyID StandardCrypto
pid1, Word8 -> AssetName
smallName Word8
2, Integer
1)
                  , (PolicyID StandardCrypto
pid1, Word8 -> AssetName
smallName Word8
3, Integer
1)
                  ]
              )
              forall a. StrictMaybe a
SNothing
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1448244
    , [Char] -> Assertion -> TestTree
testCase [Char]
"one policy, one (largest) name" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
carlAddr
              (forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList (Integer -> Coin
Coin Integer
1555554) [(PolicyID StandardCrypto
pid1, Word8 -> AssetName
largestName Word8
65, Integer
1)])
              forall a. StrictMaybe a
SNothing
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1448244
    , [Char] -> Assertion -> TestTree
testCase [Char]
"one policy, three (largest) name, with hash" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
carlAddr
              ( forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList
                  (Integer -> Coin
Coin Integer
1962961)
                  [ (PolicyID StandardCrypto
pid1, Word8 -> AssetName
largestName Word8
65, Integer
1)
                  , (PolicyID StandardCrypto
pid1, Word8 -> AssetName
largestName Word8
66, Integer
1)
                  , (PolicyID StandardCrypto
pid1, Word8 -> AssetName
largestName Word8
67, Integer
1)
                  ]
              )
              (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData @Alonzo (forall era. Era era => Data -> Data era
Data (Integer -> [Data] -> Data
PV1.Constr Integer
0 [Integer -> [Data] -> Data
PV1.Constr Integer
0 []])))
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
2172366
    , [Char] -> Assertion -> TestTree
testCase [Char]
"two policies, one (smallest) name" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
aliceAddr
              (forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList (Integer -> Coin
Coin Integer
1592591) [(PolicyID StandardCrypto
pid1, AssetName
smallestName, Integer
1), (PolicyID StandardCrypto
pid2, AssetName
smallestName, Integer
1)])
              forall a. StrictMaybe a
SNothing
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1482726
    , [Char] -> Assertion -> TestTree
testCase [Char]
"two policies, one (smallest) name, with hash" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
aliceAddr
              (forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList (Integer -> Coin
Coin Integer
1592591) [(PolicyID StandardCrypto
pid1, AssetName
smallestName, Integer
1), (PolicyID StandardCrypto
pid2, AssetName
smallestName, Integer
1)])
              (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData @Alonzo (forall era. Era era => Data -> Data era
Data (Integer -> [Data] -> Data
PV1.Constr Integer
0 [])))
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1827546
    , [Char] -> Assertion -> TestTree
testCase [Char]
"two policies, two (small) names" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
bobAddr
              (forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList (Integer -> Coin
Coin Integer
1629628) [(PolicyID StandardCrypto
pid1, Word8 -> AssetName
smallName Word8
1, Integer
1), (PolicyID StandardCrypto
pid2, Word8 -> AssetName
smallName Word8
2, Integer
1)])
              forall a. StrictMaybe a
SNothing
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
1517208
    , [Char] -> Assertion -> TestTree
testCase [Char]
"three policies, ninety-six (small) names" forall a b. (a -> b) -> a -> b
$
        AlonzoTxOut Alonzo -> Coin
calcMinUTxO
          ( forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut
              forall c. Crypto c => Addr c
aliceAddr
              ( let f :: a -> Word8 -> (a, AssetName, c)
f a
i Word8
c = (a
i, Word8 -> AssetName
smallName Word8
c, c
1)
                 in forall era.
Coin -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
valueFromList
                      (Integer -> Coin
Coin Integer
7407400)
                      [ forall {c} {a}. Num c => a -> Word8 -> (a, AssetName, c)
f PolicyID StandardCrypto
i Word8
c
                      | (PolicyID StandardCrypto
i, [Word8]
cs) <-
                          [(PolicyID StandardCrypto
pid1, [Word8
32 .. Word8
63]), (PolicyID StandardCrypto
pid2, [Word8
64 .. Word8
95]), (PolicyID StandardCrypto
pid3, [Word8
96 .. Word8
127])]
                      , Word8
c <- [Word8]
cs
                      ]
              )
              forall a. StrictMaybe a
SNothing
          )
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer -> Coin
Coin Integer
6896400
    , [Char] -> Assertion -> TestTree
testCase [Char]
"utxo entry size of ada-only" forall a b. (a -> b) -> a -> b
$
        -- This value, 29, is helpful for comparing the alonzo protocol parameter utxoCostPerWord
        -- with the old parameter minUTxOValue.
        -- If we wish to keep the ada-only, no datum hash, minimum value nearly the same,
        -- we can divide minUTxOValue by 29 and round.
        forall era. AlonzoEraTxOut era => TxOut era -> Integer
utxoEntrySize @Alonzo (forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut forall c. Crypto c => Addr c
aliceAddr forall a. Monoid a => a
mempty forall a. StrictMaybe a
SNothing) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Integer
29
    ]

goldenCborSerialization :: TestTree
goldenCborSerialization :: TestTree
goldenCborSerialization =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"golden tests - CBOR serialization"
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"Alonzo Block" forall a b. (a -> b) -> a -> b
$ do
        ByteString
expected <- [Char] -> IO ByteString
readDataFile [Char]
"golden/block.cbor"
        forall a. ToCBOR a => a -> ByteString
Plain.serialize (forall era.
ShelleyLedgerExamples era -> Block (BHeader (EraCrypto era)) era
SLE.sleBlock ShelleyLedgerExamples Alonzo
ledgerExamplesAlonzo) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ByteString
expected
    , [Char] -> Assertion -> TestTree
testCase [Char]
"Alonzo Tx" forall a b. (a -> b) -> a -> b
$ do
        ByteString
expected <- [Char] -> IO ByteString
readDataFile [Char]
"golden/tx.cbor"
        forall a. ToCBOR a => a -> ByteString
Plain.serialize (forall era. ShelleyLedgerExamples era -> Tx era
SLE.sleTx ShelleyLedgerExamples Alonzo
ledgerExamplesAlonzo) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ByteString
expected
    ]

goldenJsonSerialization :: TestTree
goldenJsonSerialization :: TestTree
goldenJsonSerialization =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"golden tests - JSON serialization"
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"ValidityInterval" forall a b. (a -> b) -> a -> b
$ do
        let value :: [ValidityInterval]
value =
              [ ValidityInterval
                  { invalidBefore :: StrictMaybe SlotNo
invalidBefore = forall a. StrictMaybe a
SNothing
                  , invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = forall a. StrictMaybe a
SNothing
                  }
              , ValidityInterval
                  { invalidBefore :: StrictMaybe SlotNo
invalidBefore = forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
12345)
                  , invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = forall a. StrictMaybe a
SNothing
                  }
              , ValidityInterval
                  { invalidBefore :: StrictMaybe SlotNo
invalidBefore = forall a. StrictMaybe a
SNothing
                  , invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
12354)
                  }
              , ValidityInterval
                  { invalidBefore :: StrictMaybe SlotNo
invalidBefore = forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
12345)
                  , invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
12354)
                  }
              ]
        Value
expected <- forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
Aeson.throwDecode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO ByteString
readDataFile [Char]
"golden/ValidityInterval.json"
        forall a. ToJSON a => a -> Value
Aeson.toJSON [ValidityInterval]
value forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Value
expected
    , [Char] -> Assertion -> TestTree
testCase [Char]
"IsValid" forall a b. (a -> b) -> a -> b
$ do
        let value :: [IsValid]
value =
              [ Bool -> IsValid
IsValid Bool
True
              , Bool -> IsValid
IsValid Bool
False
              ]
        Value
expected <- forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
Aeson.throwDecode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO ByteString
readDataFile [Char]
"golden/IsValid.json"
        forall a. ToJSON a => a -> Value
Aeson.toJSON [IsValid]
value forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Value
expected
    , [Char] -> Assertion -> TestTree
testCase [Char]
"FailureDescription" forall a b. (a -> b) -> a -> b
$ do
        let value :: [FailureDescription]
value =
              [ Text -> ByteString -> FailureDescription
PlutusFailure Text
"A description" ByteString
"A reconstruction"
              ]
        Value
expected <- forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
Aeson.throwDecode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO ByteString
readDataFile [Char]
"golden/FailureDescription.json"
        forall a. ToJSON a => a -> Value
Aeson.toJSON [FailureDescription]
value forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Value
expected
    , [Char] -> Assertion -> TestTree
testCase [Char]
"TagMismatchDescription" forall a b. (a -> b) -> a -> b
$ do
        let value :: [TagMismatchDescription]
value =
              [ TagMismatchDescription
PassedUnexpectedly
              , NonEmpty FailureDescription -> TagMismatchDescription
FailedUnexpectedly (forall a. [a] -> NonEmpty a
NE.fromList [Text -> ByteString -> FailureDescription
PlutusFailure Text
"A description" ByteString
"A reconstruction"])
              ]
        Value
expected <- forall a (m :: * -> *).
(FromJSON a, MonadThrow m) =>
ByteString -> m a
Aeson.throwDecode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO ByteString
readDataFile [Char]
"golden/TagMismatchDescription.json"
        forall a. ToJSON a => a -> Value
Aeson.toJSON [TagMismatchDescription]
value forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Value
expected
    ]

goldenGenesisSerialization :: TestTree
goldenGenesisSerialization :: TestTree
goldenGenesisSerialization =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"golden tests - Alonzo Genesis serialization"
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"JSON deserialization" forall a b. (a -> b) -> a -> b
$ do
        let file :: [Char]
file = [Char]
"golden/mainnet-alonzo-genesis.json"
        Either [Char] AlonzoGenesis
deserialized <- (forall a. FromJSON a => [Char] -> IO (Either [Char] a)
eitherDecodeFileStrict [Char]
file :: IO (Either String AlonzoGenesis))
        Either [Char] AlonzoGenesis
deserialized forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right AlonzoGenesis
expectedGenesis
    ]

goldenMinFee :: TestTree
goldenMinFee :: TestTree
goldenMinFee =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"golden tests - minimum fee calculation"
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"Alonzo Block" forall a b. (a -> b) -> a -> b
$ do
        -- This golden test uses the block from:
        -- https://github.com/input-output-hk/cardano-node/issues/4228#issuecomment-1195707491
        --
        -- The first transaction in this block is invalid due to:
        --   FeeTooSmallUTxO (Coin 1006053) (Coin 1001829)
        --
        -- The correct behavior is for the minimum fee for this transaction
        -- to be 1006053 lovelace, as indicated by the failure above.
        -- Nodes that had the bug determined the minimum fee to be 1001829.
        ByteString
hex <- [Char] -> IO ByteString
readDataFile [Char]
"golden/hex-block-node-issue-4228.cbor"
        let cborBytesBlock :: ByteString
cborBytesBlock =
              case ByteString -> Either [Char] ByteString
B16L.decode ByteString
hex of
                Left [Char]
err -> forall a. HasCallStack => [Char] -> a
error [Char]
err
                Right ByteString
val -> ByteString
val
            txsSeq :: AlonzoTxSeq Alonzo
txsSeq =
              case forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator (forall era. Era era => Version
eraProtVerHigh @Alonzo) Text
"Block" forall a s. DecCBOR a => Decoder s a
decCBOR ByteString
cborBytesBlock of
                Left DecoderError
err -> forall a. HasCallStack => [Char] -> a
error (forall a. Show a => a -> [Char]
show DecoderError
err)
                Right (Block BHeader StandardCrypto
_h TxSeq Alonzo
txs :: Block (BHeader StandardCrypto) Alonzo) -> TxSeq Alonzo
txs
            firstTx :: AlonzoTx Alonzo
firstTx =
              case forall era. EraSegWits era => TxSeq era -> StrictSeq (Tx era)
fromTxSeq @Alonzo AlonzoTxSeq Alonzo
txsSeq of
                AlonzoTx Alonzo
tx :<| StrictSeq (AlonzoTx Alonzo)
_ -> AlonzoTx Alonzo
tx
                StrictSeq (Tx Alonzo)
StrictSeq (AlonzoTx Alonzo)
Empty -> forall a. HasCallStack => [Char] -> a
error [Char]
"Block doesn't have any transactions"

            -- Below are the relevant protocol parameters that were active
            -- at the time this block was rejected.
            priceMem :: NonNegativeInterval
priceMem = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
0.0577
            priceSteps :: NonNegativeInterval
priceSteps = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
0.0000721
            pricesParam :: Prices
pricesParam = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices NonNegativeInterval
priceMem NonNegativeInterval
priceSteps
            pp :: PParams Alonzo
pp =
              forall era. EraPParams era => PParams era
emptyPParams
                forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
44
                forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
155381
                forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Prices
pricesParam

        Integer -> Coin
Coin Integer
1006053 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 Alonzo
pp AlonzoTx Alonzo
firstTx
    ]

fromRightError :: (HasCallStack, Show a) => String -> Either a b -> b
fromRightError :: forall a b. (HasCallStack, Show a) => [Char] -> Either a b -> b
fromRightError [Char]
errorMsg =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
e -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
errorMsg forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
e) forall a. a -> a
id

exPP :: PParams Alonzo
exPP :: PParams Alonzo
exPP =
  forall era. EraPParams era => PParams era
emptyPParams
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1, Language
PlutusV2]

exampleLangDepViewPV1 :: LangDepView
exampleLangDepViewPV1 :: LangDepView
exampleLangDepViewPV1 = ByteString -> ByteString -> LangDepView
LangDepView ByteString
b1 ByteString
b2
  where
    b1 :: ByteString
b1 =
      forall a b. (HasCallStack, Show a) => [Char] -> Either a b -> b
fromRightError [Char]
"invalid hex encoding of the language inside exampleLangDepViewPV1" forall a b. (a -> b) -> a -> b
$
        ByteString -> Either [Char] ByteString
B16.decode ByteString
"4100"
    b2 :: ByteString
b2 =
      forall a b. (HasCallStack, Show a) => [Char] -> Either a b -> b
fromRightError [Char]
"invalid hex encoding of the cost model inside exampleLangDepViewPV1" forall a b. (a -> b) -> a -> b
$
        ByteString -> Either [Char] ByteString
B16.decode forall a b. (a -> b) -> a -> b
$
          ByteString
"58a89f0000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"000000000000000000ff"

exampleLangDepViewPV2 :: LangDepView
exampleLangDepViewPV2 :: LangDepView
exampleLangDepViewPV2 = ByteString -> ByteString -> LangDepView
LangDepView ByteString
b1 ByteString
b2
  where
    b1 :: ByteString
b1 =
      forall a b. (HasCallStack, Show a) => [Char] -> Either a b -> b
fromRightError [Char]
"invalid hex encoding of the language inside exampleLangDepViewPV2" forall a b. (a -> b) -> a -> b
$
        ByteString -> Either [Char] ByteString
B16.decode ByteString
"01"
    b2 :: ByteString
b2 =
      forall a b. (HasCallStack, Show a) => [Char] -> Either a b -> b
fromRightError [Char]
"invalid hex encoding of the cost model inside exampleLangDepViewPV2" forall a b. (a -> b) -> a -> b
$
        ByteString -> Either [Char] ByteString
B16.decode forall a b. (a -> b) -> a -> b
$
          ByteString
"98af000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000000000000000000000000000000000"
            forall a. Semigroup a => a -> a -> a
<> ByteString
"0000000000000000000000000000000000"

testScriptIntegritpHash ::
  HasCallStack =>
  PParams Alonzo ->
  Language ->
  LangDepView ->
  Assertion
testScriptIntegritpHash :: HasCallStack =>
PParams Alonzo -> Language -> LangDepView -> Assertion
testScriptIntegritpHash PParams Alonzo
pp Language
lang LangDepView
view = forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams Alonzo
pp Language
lang forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= LangDepView
view

goldenScriptIntegrity :: TestTree
goldenScriptIntegrity :: TestTree
goldenScriptIntegrity =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"golden tests - script integrity hash"
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"PlutusV1" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
PParams Alonzo -> Language -> LangDepView -> Assertion
testScriptIntegritpHash PParams Alonzo
exPP Language
PlutusV1 LangDepView
exampleLangDepViewPV1
    , [Char] -> Assertion -> TestTree
testCase [Char]
"PlutusV2" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
PParams Alonzo -> Language -> LangDepView -> Assertion
testScriptIntegritpHash PParams Alonzo
exPP Language
PlutusV2 LangDepView
exampleLangDepViewPV2
    ]

expectedGenesis :: AlonzoGenesis
expectedGenesis :: AlonzoGenesis
expectedGenesis =
  AlonzoGenesis
    { agCoinsPerUTxOWord :: CoinPerWord
agCoinsPerUTxOWord = Coin -> CoinPerWord
CoinPerWord forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
34482
    , agPrices :: Prices
agPrices = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
0.0577) (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
0.0000721)
    , agCostModels :: CostModels
agCostModels = CostModels
expectedCostModels
    , agMaxTxExUnits :: ExUnits
agMaxTxExUnits = Natural -> Natural -> ExUnits
ExUnits Natural
10000000 Natural
10000000000
    , agMaxBlockExUnits :: ExUnits
agMaxBlockExUnits = Natural -> Natural -> ExUnits
ExUnits Natural
50000000 Natural
40000000000
    , agMaxValSize :: Natural
agMaxValSize = Natural
5000
    , agCollateralPercentage :: Natural
agCollateralPercentage = Natural
150
    , agMaxCollateralInputs :: Natural
agMaxCollateralInputs = Natural
3
    }

expectedCostModels :: CostModels
expectedCostModels :: CostModels
expectedCostModels =
  Map Language CostModel -> CostModels
mkCostModels
    (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Language
PlutusV1, CostModel
expectedCostModel), (Language
PlutusV2, CostModel
expectedCostModelV2)])

expectedCostModel :: CostModel
expectedCostModel :: CostModel
expectedCostModel =
  forall b a. b -> Either a b -> b
fromRight
    (forall a. HasCallStack => [Char] -> a
error ([Char]
"Error creating CostModel from known parameters" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Int64]
expectedPParams))
    (Language -> [Int64] -> Either CostModelApplyError CostModel
mkCostModel Language
PlutusV1 [Int64]
expectedPParams)

expectedCostModelV2 :: CostModel
expectedCostModelV2 :: CostModel
expectedCostModelV2 =
  forall b a. b -> Either a b -> b
fromRight
    (forall a. HasCallStack => [Char] -> a
error ([Char]
"Error creating CostModel from known PlutusV2 parameters" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Int64]
expectedPParams))
    (Language -> [Int64] -> Either CostModelApplyError CostModel
mkCostModel Language
PlutusV2 ([Int64]
expectedPParams forall a. [a] -> [a] -> [a]
++ (forall a. Int -> a -> [a]
replicate Int
9 Int64
0)))

expectedPParams :: [Int64]
expectedPParams :: [Int64]
expectedPParams =
  [ Int64
197209
  , Int64
0
  , Int64
1
  , Int64
1
  , Int64
396231
  , Int64
621
  , Int64
0
  , Int64
1
  , Int64
150000
  , Int64
1000
  , Int64
0
  , Int64
1
  , Int64
150000
  , Int64
32
  , Int64
2477736
  , Int64
29175
  , Int64
4
  , Int64
29773
  , Int64
100
  , Int64
29773
  , Int64
100
  , Int64
29773
  , Int64
100
  , Int64
29773
  , Int64
100
  , Int64
29773
  , Int64
100
  , Int64
29773
  , Int64
100
  , Int64
100
  , Int64
100
  , Int64
29773
  , Int64
100
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
1000
  , Int64
0
  , Int64
1
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
1000
  , Int64
0
  , Int64
8
  , Int64
148000
  , Int64
425507
  , Int64
118
  , Int64
0
  , Int64
1
  , Int64
1
  , Int64
150000
  , Int64
1000
  , Int64
0
  , Int64
8
  , Int64
150000
  , Int64
112536
  , Int64
247
  , Int64
1
  , Int64
150000
  , Int64
10000
  , Int64
1
  , Int64
136542
  , Int64
1326
  , Int64
1
  , Int64
1000
  , Int64
150000
  , Int64
1000
  , Int64
1
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
1
  , Int64
1
  , Int64
150000
  , Int64
1
  , Int64
150000
  , Int64
4
  , Int64
103599
  , Int64
248
  , Int64
1
  , Int64
103599
  , Int64
248
  , Int64
1
  , Int64
145276
  , Int64
1366
  , Int64
1
  , Int64
179690
  , Int64
497
  , Int64
1
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
148000
  , Int64
425507
  , Int64
118
  , Int64
0
  , Int64
1
  , Int64
1
  , Int64
61516
  , Int64
11218
  , Int64
0
  , Int64
1
  , Int64
150000
  , Int64
32
  , Int64
148000
  , Int64
425507
  , Int64
118
  , Int64
0
  , Int64
1
  , Int64
1
  , Int64
148000
  , Int64
425507
  , Int64
118
  , Int64
0
  , Int64
1
  , Int64
1
  , Int64
2477736
  , Int64
29175
  , Int64
4
  , Int64
0
  , Int64
82363
  , Int64
4
  , Int64
150000
  , Int64
5000
  , Int64
0
  , Int64
1
  , Int64
150000
  , Int64
32
  , Int64
197209
  , Int64
0
  , Int64
1
  , Int64
1
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
150000
  , Int64
32
  , Int64
3345831
  , Int64
1
  , Int64
1
  ]