{-# 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.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API as Ledger
import qualified Cardano.Ledger.Shelley.Rules as STS
import Cardano.Protocol.Crypto (StandardCrypto)
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.Cardano.Protocol.Binary.Annotator ()
import Test.Tasty
import Test.Tasty.QuickCheck (testProperty)

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

testCoreTypes :: TestTree
testCoreTypes :: TestTree
testCoreTypes =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Core Types"
    [ TestName -> (BHeader StandardCrypto -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Header (Annotator)" ((BHeader StandardCrypto -> Expectation) -> TestTree)
-> (BHeader StandardCrypto -> Expectation) -> TestTree
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)
    , TestName -> (BHeader StandardCrypto -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Header" ((BHeader StandardCrypto -> Expectation) -> TestTree)
-> (BHeader StandardCrypto -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
Version -> Version -> t -> Expectation
roundTripCborRangeExpectation @(TP.BHeader StandardCrypto) Version
forall a. Bounded a => a
minBound Version
forall a. Bounded a => a
maxBound
    , TestName -> (HashHeader -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Block Header Hash" ((HashHeader -> Expectation) -> TestTree)
-> (HashHeader -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation @TP.HashHeader Trip HashHeader HashHeader
forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    , TestName -> (PrtclState -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Protocol State" ((PrtclState -> Expectation) -> TestTree)
-> (PrtclState -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation @STS.PrtclState Trip PrtclState PrtclState
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"
    [ TestName
-> (Block (BHeader StandardCrypto) ShelleyEra -> Expectation)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Block (Annotator)" ((Block (BHeader StandardCrypto) ShelleyEra -> Expectation)
 -> TestTree)
-> (Block (BHeader StandardCrypto) ShelleyEra -> Expectation)
-> TestTree
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) ShelleyEra)
          (forall era. Era era => Version
eraProtVerLow @ShelleyEra)
          (forall era. Era era => Version
eraProtVerHigh @ShelleyEra)
    , TestName
-> (Block (BHeader StandardCrypto) ShelleyEra -> Expectation)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Block" ((Block (BHeader StandardCrypto) ShelleyEra -> Expectation)
 -> TestTree)
-> (Block (BHeader StandardCrypto) ShelleyEra -> Expectation)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
Version -> Version -> t -> Expectation
roundTripCborRangeExpectation @(Block (TP.BHeader StandardCrypto) ShelleyEra)
          (forall era. Era era => Version
eraProtVerLow @ShelleyEra)
          (forall era. Era era => Version
eraProtVerHigh @ShelleyEra)
    , TestName
-> ([PredicateFailure (ShelleyLEDGERS ShelleyEra)] -> Expectation)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"LEDGER Predicate Failures" (([PredicateFailure (ShelleyLEDGERS ShelleyEra)] -> Expectation)
 -> TestTree)
-> ([PredicateFailure (ShelleyLEDGERS ShelleyEra)] -> Expectation)
-> TestTree
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 ShelleyEra)] Trip
  [PredicateFailure (ShelleyLEDGERS ShelleyEra)]
  [PredicateFailure (ShelleyLEDGERS ShelleyEra)]
Trip
  [ShelleyLedgersPredFailure ShelleyEra]
  [ShelleyLedgersPredFailure ShelleyEra]
forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    , TestTree
testCoreTypes
    ]