{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Cardano.Ledger.PlutusSpec (spec) where
import Cardano.Ledger.BaseTypes (
EpochInterval (..),
NonNegativeInterval,
ProtVer (..),
UnitInterval,
)
import Cardano.Ledger.Binary.Version (Version)
import Cardano.Ledger.Coin (Coin, CompactForm)
import Cardano.Ledger.Plutus
import Data.Map.Strict (Map)
import Data.Word
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Plutus.ToPlutusData (roundTripPlutusDataSpec)
spec :: Spec
spec :: Spec
spec = do
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Plutus" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
Spec
costModelsSpec
Spec
exUnitsSpec
Spec
dataSpec
costModelsSpec :: Spec
costModelsSpec :: Spec
costModelsSpec = do
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CostModels" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> (CostModels -> Map Word8 [Int64] -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"flattenCostModels . mkCostModelsLenient" ((CostModels -> Map Word8 [Int64] -> IO ()) -> Spec)
-> (CostModels -> Map Word8 [Int64] -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \CostModels
valid Map Word8 [Int64]
unknown -> do
let cms1Flat :: Map Word8 [Int64]
cms1Flat = CostModels -> Map Word8 [Int64]
flattenCostModels CostModels
valid Map Word8 [Int64] -> Map Word8 [Int64] -> Map Word8 [Int64]
forall a. Semigroup a => a -> a -> a
<> Map Word8 [Int64]
unknown
cms2Flat :: Map Word8 [Int64]
cms2Flat = Map Word8 [Int64]
unknown Map Word8 [Int64] -> Map Word8 [Int64] -> Map Word8 [Int64]
forall a. Semigroup a => a -> a -> a
<> CostModels -> Map Word8 [Int64]
flattenCostModels CostModels
valid
CostModels
cms1 <- Map Word8 [Int64] -> IO CostModels
forall (m :: * -> *).
MonadFail m =>
Map Word8 [Int64] -> m CostModels
mkCostModelsLenient Map Word8 [Int64]
cms1Flat
CostModels
cms2 <- Map Word8 [Int64] -> IO CostModels
forall (m :: * -> *).
MonadFail m =>
Map Word8 [Int64] -> m CostModels
mkCostModelsLenient Map Word8 [Int64]
cms2Flat
CostModels -> Map Word8 [Int64]
flattenCostModels CostModels
cms1 Map Word8 [Int64] -> Map Word8 [Int64] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Map Word8 [Int64]
cms1Flat
CostModels -> Map Word8 [Int64]
flattenCostModels CostModels
cms2 Map Word8 [Int64] -> Map Word8 [Int64] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Map Word8 [Int64]
cms2Flat
exUnitsSpec :: Spec
exUnitsSpec :: Spec
exUnitsSpec = do
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ExUnits" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Gen Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Round-trip to ExBudget" Gen Property
exUnitsToExBudgetRoundTrip
String -> Gen Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Round-trip from ExBudget" Gen Property
exBudgetToExUnitsRoundTrip
exUnitsToExBudgetRoundTrip :: Gen Property
exUnitsToExBudgetRoundTrip :: Gen Property
exUnitsToExBudgetRoundTrip = do
ExUnits
e <- Gen ExUnits
forall a. Arbitrary a => Gen a
arbitrary
let result :: Maybe ExUnits
result = ExBudget -> Maybe ExUnits
exBudgetToExUnits (ExBudget -> Maybe ExUnits) -> ExBudget -> Maybe ExUnits
forall a b. (a -> b) -> a -> b
$ ExUnits -> ExBudget
transExUnits ExUnits
e
Property -> Gen Property
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Property -> Gen Property) -> Property -> Gen Property
forall a b. (a -> b) -> a -> b
$ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
( String
"Before: "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ExUnits -> String
forall a. Show a => a -> String
show ExUnits
e
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n After: "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe ExUnits -> String
forall a. Show a => a -> String
show Maybe ExUnits
result
)
(Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Maybe ExUnits
result Maybe ExUnits -> Maybe ExUnits -> Bool
forall a. Eq a => a -> a -> Bool
== ExUnits -> Maybe ExUnits
forall a. a -> Maybe a
Just ExUnits
e
exBudgetToExUnitsRoundTrip :: Gen Property
exBudgetToExUnitsRoundTrip :: Gen Property
exBudgetToExUnitsRoundTrip = do
ExBudget
e <- Gen ExBudget
forall a. Arbitrary a => Gen a
arbitrary
let result :: Maybe ExBudget
result = ExUnits -> ExBudget
transExUnits (ExUnits -> ExBudget) -> Maybe ExUnits -> Maybe ExBudget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExBudget -> Maybe ExUnits
exBudgetToExUnits ExBudget
e
Property -> Gen Property
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Property -> Gen Property) -> Property -> Gen Property
forall a b. (a -> b) -> a -> b
$ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
( String
"Before: "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ExBudget -> String
forall a. Show a => a -> String
show ExBudget
e
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n After: "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe ExBudget -> String
forall a. Show a => a -> String
show Maybe ExBudget
result
)
(Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Maybe ExBudget
result Maybe ExBudget -> Maybe ExBudget -> Bool
forall a. Eq a => a -> a -> Bool
== ExBudget -> Maybe ExBudget
forall a. a -> Maybe a
Just ExBudget
e
dataSpec :: Spec
dataSpec :: Spec
dataSpec = do
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip ToPlutusData" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Version
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Word
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Word8
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Word16
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Word32
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @[Word]
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @[Word8]
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @(Map Word Version)
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Coin
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @(CompactForm Coin)
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @ExUnits
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Prices
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Natural
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @UnitInterval
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @EpochInterval
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @NonNegativeInterval
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @ProtVer
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @CostModels
forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Integer