{-# 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,
  NonZero,
  PositiveInterval,
  ProtVer (..),
  UnitInterval,
 )
import Cardano.Ledger.Binary.Version (Version)
import Cardano.Ledger.Coin (Coin, CoinPerByte, CompactForm)
import Cardano.Ledger.Core (MaxPledgeLeverage)
import Cardano.Ledger.Plutus
import Cardano.Slotting.Slot (SlotInterval (..))
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
      cms1 <- Map Word8 [Int64] -> IO CostModels
forall (m :: * -> *).
MonadFail m =>
Map Word8 [Int64] -> m CostModels
mkCostModelsLenient Map Word8 [Int64]
cms1Flat
      cms2 <- mkCostModelsLenient cms2Flat
      flattenCostModels cms1 `shouldBe` cms1Flat
      flattenCostModels cms2 `shouldBe` 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

-- ExUnits should remain intact when translating to and from the Plutus ExBudget type
exUnitsToExBudgetRoundTrip :: Gen Property
exUnitsToExBudgetRoundTrip :: Gen Property
exUnitsToExBudgetRoundTrip = do
  e <- Gen ExUnits
forall a. Arbitrary a => Gen a
arbitrary
  let result = ExBudget -> Maybe ExUnits
exBudgetToExUnits (ExBudget -> Maybe ExUnits) -> ExBudget -> Maybe ExUnits
forall a b. (a -> b) -> a -> b
$ ExUnits -> ExBudget
transExUnits ExUnits
e
  pure
    $ counterexample
      ( "Before: "
          <> show e
          <> "\n After: "
          <> show result
      )
    $ result == Just e

-- Plutus ExBudget should remain intact when translating to and from the ExUnits type
exBudgetToExUnitsRoundTrip :: Gen Property
exBudgetToExUnitsRoundTrip :: Gen Property
exBudgetToExUnitsRoundTrip = do
  e <- Gen ExBudget
forall a. Arbitrary a => Gen a
arbitrary
  let 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
  pure
    $ counterexample
      ( "Before: "
          <> show e
          <> "\n After: "
          <> show result
      )
    $ result == Just 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 @ProtVer
    forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
 ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @Rational
    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 @NonNegativeInterval
    forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
 ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @PositiveInterval
    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 @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 @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 @CoinPerByte
    forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
 ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @MaxPledgeLeverage
    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 @Word16
    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 @EpochInterval
    forall x.
(HasCallStack, Typeable x, Show x, Eq x, Arbitrary x,
 ToPlutusData x) =>
Spec
roundTripPlutusDataSpec @SlotInterval
    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 @Integer
    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 @(NonZero Integer)
    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)