{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Core.Binary (
  decoderEquivalenceSpec,
  decoderEquivalenceEraSpec,
  txSizeSpec,
  decoderEquivalenceCoreEraTypesSpec,
  Mem,
  fullAnnCddlSpec,
  fullAnnGenCddlSpec,
  fullCddlSpec,
  fullGenCddlSpec,
) where

import Cardano.Ledger.Binary (Annotator, DecCBOR, EncCBOR, Version)
import qualified Cardano.Ledger.Binary.Decoding as Dec (label)
import Cardano.Ledger.Core
import Cardano.Ledger.MemoBytes (Mem)
import Data.Proxy (Proxy (..))
import qualified Data.Text as T
import Lens.Micro
import Test.Cardano.Ledger.Binary (decoderEquivalenceSpec)
import Test.Cardano.Ledger.Binary.Cuddle (
  HuddleEnv,
  huddleAntiCborProp,
  huddleDecoderEquivalenceProp,
  huddleRoundTripAnnCborProp,
  huddleRoundTripCborProp,
  huddleRoundTripGenValidateProp,
 )
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Core.Binary.Annotator

txSizeSpec ::
  forall era.
  ( EraTx era
  , Arbitrary (Tx TopTx era)
  , SafeToHash (TxWits era)
  ) =>
  Spec
txSizeSpec :: forall era.
(EraTx era, Arbitrary (Tx TopTx era), SafeToHash (TxWits era)) =>
Spec
txSizeSpec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Transaction size" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (Tx TopTx era -> Expectation) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"should match the size of the cbor encoding" ((Tx TopTx era -> Expectation) -> Spec)
-> (Tx TopTx era -> Expectation) -> Spec
forall a b. (a -> b) -> a -> b
$ \(Tx TopTx era
tx :: Tx TopTx era) -> do
      let txSize :: Word32
txSize = Tx TopTx era -> Word32
forall era (l :: TxLevel).
(EraTx era, HasCallStack, SafeToHash (TxWits era), Typeable l) =>
Tx l era -> Word32
forall (l :: TxLevel).
(HasCallStack, SafeToHash (TxWits era), Typeable l) =>
Tx l era -> Word32
sizeTxForFeeCalculation Tx TopTx era
tx
      Word32
txSize Word32 -> Word32 -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Tx TopTx era
tx Tx TopTx era -> Getting Word32 (Tx TopTx era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx era) Word32
forall era (l :: TxLevel).
(EraTx era, HasCallStack) =>
SimpleGetter (Tx l era) Word32
SimpleGetter (Tx TopTx era) Word32
forall (l :: TxLevel).
HasCallStack =>
SimpleGetter (Tx l era) Word32
sizeTxF

-- | Like 'fullAnnCddlSpec' but with a custom generator.
fullAnnGenCddlSpec ::
  forall a.
  ( Eq a
  , Show a
  , EncCBOR a
  , DecCBOR a
  , DecCBOR (Annotator a)
  , HasCallStack
  ) =>
  Gen a ->
  Version ->
  T.Text ->
  SpecWith HuddleEnv
fullAnnGenCddlSpec :: forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, DecCBOR (Annotator a),
 HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullAnnGenCddlSpec Gen a
gen Version
version Text
ruleName =
  String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (Text -> String
T.unpack Text
ruleName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Proxy a -> Text
forall a. DecCBOR a => Proxy a -> Text
Dec.label (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))) (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$ do
    String
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Generate bytestring from CDDL and decode -> encode" ((HuddleEnv -> Property) -> SpecM (Arg (HuddleEnv -> Property)) ())
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a b. (a -> b) -> a -> b
$
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> HuddleEnv -> Property
huddleRoundTripCborProp @a Version
version Text
ruleName
    String
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Generate bytestring from CDDL and decode (annotator) -> encode" ((HuddleEnv -> Property) -> SpecM (Arg (HuddleEnv -> Property)) ())
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a b. (a -> b) -> a -> b
$
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> HuddleEnv -> Property
huddleRoundTripAnnCborProp @a Version
version Text
ruleName
    String
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Encode an arbitrary value and check against CDDL" ((HuddleEnv -> Property) -> SpecM (Arg (HuddleEnv -> Property)) ())
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a b. (a -> b) -> a -> b
$
      forall a.
(Show a, EncCBOR a) =>
Gen a -> Version -> Text -> HuddleEnv -> Property
huddleRoundTripGenValidateProp @a Gen a
gen Version
version Text
ruleName
    String
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding fails when term is zapped" ((HuddleEnv -> Property) -> SpecM (Arg (HuddleEnv -> Property)) ())
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a b. (a -> b) -> a -> b
$
      forall a. DecCBOR a => Version -> Text -> HuddleEnv -> Property
huddleAntiCborProp @a Version
version Text
ruleName
    String
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DecCBOR instance equivalent to Annotator decoder" ((HuddleEnv -> Property) -> SpecM (Arg (HuddleEnv -> Property)) ())
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a b. (a -> b) -> a -> b
$
      forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> HuddleEnv -> Property
huddleDecoderEquivalenceProp @a Version
version Text
ruleName

-- | Full CDDL codec spec for types with both plain and Annotator decoders.
fullAnnCddlSpec ::
  forall a.
  ( Eq a
  , Show a
  , Arbitrary a
  , EncCBOR a
  , DecCBOR a
  , DecCBOR (Annotator a)
  , HasCallStack
  ) =>
  Version ->
  T.Text ->
  SpecWith HuddleEnv
fullAnnCddlSpec :: forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec = forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, DecCBOR (Annotator a),
 HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullAnnGenCddlSpec @a (forall a. Arbitrary a => Gen a
arbitrary @a)

-- | Like 'fullCddlSpec' but with a custom generator.
fullGenCddlSpec ::
  forall a.
  ( Eq a
  , Show a
  , EncCBOR a
  , DecCBOR a
  , HasCallStack
  ) =>
  Gen a ->
  Version ->
  T.Text ->
  SpecWith HuddleEnv
fullGenCddlSpec :: forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullGenCddlSpec Gen a
gen Version
version Text
ruleName =
  String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (Text -> String
T.unpack Text
ruleName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Proxy a -> Text
forall a. DecCBOR a => Proxy a -> Text
Dec.label (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))) (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$ do
    String
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Generate bytestring from CDDL and decode -> encode" ((HuddleEnv -> Property) -> SpecM (Arg (HuddleEnv -> Property)) ())
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a b. (a -> b) -> a -> b
$
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> HuddleEnv -> Property
huddleRoundTripCborProp @a Version
version Text
ruleName
    String
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Encode an arbitrary value and check against CDDL" ((HuddleEnv -> Property) -> SpecM (Arg (HuddleEnv -> Property)) ())
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a b. (a -> b) -> a -> b
$
      forall a.
(Show a, EncCBOR a) =>
Gen a -> Version -> Text -> HuddleEnv -> Property
huddleRoundTripGenValidateProp @a Gen a
gen Version
version Text
ruleName
    String
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding fails when term is zapped" ((HuddleEnv -> Property) -> SpecM (Arg (HuddleEnv -> Property)) ())
-> (HuddleEnv -> Property)
-> SpecM (Arg (HuddleEnv -> Property)) ()
forall a b. (a -> b) -> a -> b
$
      forall a. DecCBOR a => Version -> Text -> HuddleEnv -> Property
huddleAntiCborProp @a Version
version Text
ruleName

-- | CDDL codec spec for types with only plain decoders (no Annotator).
fullCddlSpec ::
  forall a.
  ( Eq a
  , Show a
  , Arbitrary a
  , EncCBOR a
  , DecCBOR a
  , HasCallStack
  ) =>
  Version ->
  T.Text ->
  SpecWith HuddleEnv
fullCddlSpec :: forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec = forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullGenCddlSpec @a (forall a. Arbitrary a => Gen a
arbitrary @a)