{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Shelley.Serialisation.Tripping.CBOR (
  tests,
)
where

import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (StandardCrypto)
import Cardano.Ledger.Shelley (Shelley)
import Cardano.Ledger.Shelley.API as Ledger
import qualified Cardano.Ledger.Shelley.Rules as STS
import qualified Cardano.Protocol.TPraos.BHeader as TP
import qualified Cardano.Protocol.TPraos.Rules.Prtcl as STS (PrtclState)
import Test.Cardano.Ledger.Binary.RoundTrip
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Tasty
import Test.Tasty.QuickCheck (testProperty)

{-------------------------------------------------------------------------------
  Serialization Properties
-------------------------------------------------------------------------------}

testCoreTypes :: TestTree
testCoreTypes :: TestTree
testCoreTypes =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Core Types"
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Header" forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
t -> Expectation
roundTripAnnExpectation @(TP.BHeader StandardCrypto)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Block Header Hash" forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation @(TP.HashHeader StandardCrypto) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Protocol State" forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation @(STS.PrtclState StandardCrypto) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    ]

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Serialisation roundtrip Property Tests"
    forall a b. (a -> b) -> a -> b
$ [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Block" forall a b. (a -> b) -> a -> b
$
          forall t.
(Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
Version -> Version -> t -> Expectation
roundTripAnnRangeExpectation @(Block (TP.BHeader StandardCrypto) Shelley)
            (forall era. Era era => Version
eraProtVerLow @Shelley)
            (forall era. Era era => Version
eraProtVerHigh @Shelley)
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"LEDGER Predicate Failures" forall a b. (a -> b) -> a -> b
$
          forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation @([STS.PredicateFailure (STS.ShelleyLEDGERS Shelley)]) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
      , TestTree
testCoreTypes
      ]