{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Main where

import Cardano.Ledger.Block (Block (Block))
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.Rules ()
import Cardano.Ledger.Plutus (SLanguage (..))
import Cardano.Protocol.Crypto (StandardCrypto)
import qualified Cardano.Protocol.Leios.BlockHeader as Leios
import qualified Test.Cardano.Base.QuickCheck as BaseQC
import Test.Cardano.Ledger.Babbage.TxInfoSpec (txInfoSpec)
import qualified Test.Cardano.Ledger.Babbage.TxInfoSpec as BabbageTxInfo
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Binary.RoundTrip (roundTripConwayCommonSpec)
import Test.Cardano.Ledger.Core.Binary.RoundTrip (
  roundTripAnnEraExpectation,
  roundTripEraExpectation,
 )
import Test.Cardano.Ledger.Dijkstra.Arbitrary (genSmallDijkstraTxsBlockBody)
import Test.Cardano.Ledger.Dijkstra.Binary.Annotator ()
import qualified Test.Cardano.Ledger.Dijkstra.Binary.CddlSpec as Cddl
import qualified Test.Cardano.Ledger.Dijkstra.Binary.Golden as GoldenBinary
import Test.Cardano.Ledger.Dijkstra.Binary.RoundTrip ()
import qualified Test.Cardano.Ledger.Dijkstra.GoldenSpec as GoldenSpec
import qualified Test.Cardano.Ledger.Dijkstra.Imp as Imp
import Test.Cardano.Ledger.Dijkstra.ImpTest ()
import qualified Test.Cardano.Ledger.Dijkstra.Plutus.PlutusSpec as PlutusSpec
import qualified Test.Cardano.Ledger.Dijkstra.TxInfoSpec as DijkstraTxInfoSpec
import Test.Cardano.Ledger.Era
import Test.Cardano.Ledger.Shelley.JSON (roundTripJsonShelleyEraSpec)

instance EraSpec DijkstraEra where
  eraImpSpec :: Proxy DijkstraEra -> Spec
eraImpSpec = Proxy DijkstraEra -> Spec
forall era (proxy :: * -> *).
(DijkstraEraImp era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "RUPD" era) ~ RupdEvent) =>
proxy era -> Spec
Imp.spec

main :: IO ()
Expectation
main =
  forall era. EraSpec era => Spec -> Expectation
ledgerEraTestMain @DijkstraEra (Spec -> Expectation) -> Spec -> Expectation
forall a b. (a -> b) -> a -> b
$ do
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era. ConwayEraTest era => Spec
roundTripConwayCommonSpec @DijkstraEra
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Block (Leios.Header)" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
BaseQC.withNumTests Int
25 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          Gen (Block (Header StandardCrypto) DijkstraEra)
-> (Block (Header StandardCrypto) DijkstraEra -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Header StandardCrypto
-> BlockBody DijkstraEra
-> Block (Header StandardCrypto) DijkstraEra
Header StandardCrypto
-> DijkstraBlockBody DijkstraEra
-> Block (Header StandardCrypto) DijkstraEra
forall h era. h -> BlockBody era -> Block h era
Block (Header StandardCrypto
 -> DijkstraBlockBody DijkstraEra
 -> Block (Header StandardCrypto) DijkstraEra)
-> Gen (Header StandardCrypto)
-> Gen
     (DijkstraBlockBody DijkstraEra
      -> Block (Header StandardCrypto) DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Header StandardCrypto)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (DijkstraBlockBody DijkstraEra
   -> Block (Header StandardCrypto) DijkstraEra)
-> Gen (DijkstraBlockBody DijkstraEra)
-> Gen (Block (Header StandardCrypto) DijkstraEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (DijkstraBlockBody DijkstraEra)
forall era.
(AlonzoEraTx era, Arbitrary (Tx TopTx era)) =>
Gen (DijkstraBlockBody era)
genSmallDijkstraTxsBlockBody) ((Block (Header StandardCrypto) DijkstraEra -> Property)
 -> Property)
-> (Block (Header StandardCrypto) DijkstraEra -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Block (Header StandardCrypto) DijkstraEra
block ->
            [Expectation] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
              [ forall era t.
(Era era, Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripEraExpectation @DijkstraEra @(Block (Leios.Header StandardCrypto) DijkstraEra) Block (Header StandardCrypto) DijkstraEra
block
              , forall era t.
(Era era, Show t, Eq t, ToCBOR t, DecCBOR (Annotator t),
 HasCallStack) =>
t -> Expectation
roundTripAnnEraExpectation @DijkstraEra @(Block (Leios.Header StandardCrypto) DijkstraEra) Block (Header StandardCrypto) DijkstraEra
block
              ]
    Spec
Cddl.spec
    Spec
GoldenSpec.spec
    forall era. ShelleyEraTest era => Spec
roundTripJsonShelleyEraSpec @DijkstraEra
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxInfo" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era.
(EraTx era, BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era),
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
Spec
BabbageTxInfo.spec @DijkstraEra
      forall era (l :: Language).
(EraTx era, EraPlutusTxInfo l era, EraPlutusTxInfo 'PlutusV2 era,
 BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era),
 Show (PlutusTxInInfo era l), Eq (PlutusTxInInfo era l)) =>
SLanguage l -> Spec
txInfoSpec @DijkstraEra SLanguage 'PlutusV3
SPlutusV3
      forall era (l :: Language).
(EraTx era, EraPlutusTxInfo l era, EraPlutusTxInfo 'PlutusV2 era,
 BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era),
 Show (PlutusTxInInfo era l), Eq (PlutusTxInInfo era l)) =>
SLanguage l -> Spec
txInfoSpec @DijkstraEra SLanguage 'PlutusV4
SPlutusV4
      forall era.
(EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 EraPlutusTxInfo 'PlutusV3 era, EraPlutusTxInfo 'PlutusV4 era,
 Inject (DijkstraContextError era) (ContextError era),
 DijkstraEraTxBody era, EraTx era, Arbitrary (Value era)) =>
Spec
DijkstraTxInfoSpec.spec @DijkstraEra
    forall era. DijkstraEraTest era => Spec
GoldenBinary.spec @DijkstraEra
    Spec
PlutusSpec.spec