{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Binary.RoundTripSpec (spec) where

import Cardano.Crypto.DSIGN.Class (SigDSIGN, SignKeyDSIGN, SignedDSIGN, VerKeyDSIGN)
import Cardano.Crypto.DSIGN.EcdsaSecp256k1 (EcdsaSecp256k1DSIGN)
import Cardano.Crypto.DSIGN.Ed25519 (Ed25519DSIGN)
import Cardano.Crypto.DSIGN.Ed448 (Ed448DSIGN)
import Cardano.Crypto.DSIGN.Mock (MockDSIGN)
import Cardano.Crypto.DSIGN.SchnorrSecp256k1 (SchnorrSecp256k1DSIGN)
import Cardano.Crypto.Hash.Blake2b (Blake2b_224, Blake2b_256)
import Cardano.Crypto.Hash.Class (Hash)
import Cardano.Crypto.Hash.Keccak256 (Keccak256)
import Cardano.Crypto.Hash.SHA256 (SHA256)
import Cardano.Crypto.Hash.SHA3_256 (SHA3_256)
import Cardano.Crypto.Hash.Short (ShortHash)
import Cardano.Crypto.KES.Class (SigKES, SignKeyKES, VerKeyKES)
import Cardano.Crypto.KES.CompactSingle (CompactSingleKES)
import Cardano.Crypto.KES.CompactSum (
  CompactSum0KES,
  CompactSum1KES,
  CompactSum2KES,
  CompactSum3KES,
  CompactSum4KES,
  CompactSum5KES,
  CompactSum6KES,
  CompactSum7KES,
 )
import Cardano.Crypto.KES.Mock (MockKES)
import Cardano.Crypto.KES.Simple (SimpleKES)
import Cardano.Crypto.KES.Sum (
  Sum0KES,
  Sum1KES,
  Sum2KES,
  Sum3KES,
  Sum4KES,
  Sum5KES,
  Sum6KES,
  Sum7KES,
 )
import Cardano.Crypto.VRF.Class (CertVRF, CertifiedVRF, OutputVRF, SignKeyVRF, VerKeyVRF)
import Cardano.Crypto.VRF.Mock (MockVRF)
import Cardano.Crypto.VRF.Praos (PraosVRF)
import Cardano.Crypto.VRF.Simple (SimpleVRF)
import Cardano.Ledger.Binary
import Cardano.Slotting.Block (BlockNo)
import Cardano.Slotting.Slot (EpochNo, EpochSize, SlotNo, WithOrigin)
import Cardano.Slotting.Time (SystemStart)
import Codec.CBOR.ByteArray (ByteArray (..))
import Codec.CBOR.ByteArray.Sliced (SlicedByteArray (..))
import Control.Monad (when)
import Data.Fixed (Nano, Pico)
import Data.Foldable as F
import Data.IP (IPv4, IPv6)
import Data.Int
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Maybe.Strict
import qualified Data.Primitive.ByteArray as Prim (ByteArray)
import Data.Ratio
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Data.Tagged (Tagged (Tagged))
import Data.Time.Clock (UTCTime)
import qualified Data.VMap as VMap
import qualified Data.Vector as V
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import Data.Word
import Numeric.Natural
import Test.Cardano.Ledger.Binary.Arbitrary ()
import Test.Cardano.Ledger.Binary.RoundTrip
import Test.Hspec

spec :: Spec
spec :: Spec
spec = do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip" forall a b. (a -> b) -> a -> b
$ do
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @() forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Bool forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Integer forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Natural forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Word forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Word8 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Word16 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Word32 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Word64 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Int forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Int8 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Int16 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Int32 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Int64 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Float forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Double forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Rational forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Nano forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Pico forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @UTCTime forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @IPv4 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @IPv6 forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(Maybe Integer) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(StrictMaybe Integer) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @[Integer] forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(V.Vector Integer) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VS.Vector Int16) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VP.Vector Int) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VU.Vector (Bool, Word)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(Set.Set Int) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(Map.Map Integer Int) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(Seq.Seq Int) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SSeq.StrictSeq Int) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VMap.VMap VMap.VB VMap.VS Integer Int) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @Prim.ByteArray forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @ByteArray forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @SlicedByteArray forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(Maybe Integer) forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR) (forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR)
    forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(StrictMaybe Integer) forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe forall a. EncCBOR a => a -> Encoding
encCBOR) (forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe forall a s. DecCBOR a => Decoder s a
decCBOR)
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Slotting" forall a b. (a -> b) -> a -> b
$
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Mock" forall a b. (a -> b) -> a -> b
$ do
        forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @BlockNo forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @SlotNo forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(WithOrigin EpochNo) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @EpochSize forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @SystemStart forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Crypto" forall a b. (a -> b) -> a -> b
$ do
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DSIGN" forall a b. (a -> b) -> a -> b
$ do
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Ed25519" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyDSIGN Ed25519DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyDSIGN Ed25519DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigDSIGN Ed25519DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignedDSIGN Ed25519DSIGN ()) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Ed448" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyDSIGN Ed448DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyDSIGN Ed448DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigDSIGN Ed448DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignedDSIGN Ed448DSIGN ()) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"EcdsaSecp256k1" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyDSIGN EcdsaSecp256k1DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyDSIGN EcdsaSecp256k1DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigDSIGN EcdsaSecp256k1DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignedDSIGN EcdsaSecp256k1DSIGN ()) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SchnorrSecp256k1" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyDSIGN SchnorrSecp256k1DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyDSIGN SchnorrSecp256k1DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigDSIGN SchnorrSecp256k1DSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignedDSIGN SchnorrSecp256k1DSIGN ()) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Mock" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyDSIGN MockDSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyDSIGN MockDSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigDSIGN MockDSIGN) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignedDSIGN MockDSIGN ()) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"VRF" forall a b. (a -> b) -> a -> b
$ do
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"OutputVRF" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(OutputVRF PraosVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(CertifiedVRF PraosVRF Bool) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Praos" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyVRF PraosVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyVRF PraosVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(CertVRF PraosVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Simple" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyVRF SimpleVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyVRF SimpleVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(CertVRF SimpleVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Mock" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyVRF MockVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyVRF MockVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(CertVRF MockVRF) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"KES" forall a b. (a -> b) -> a -> b
$ do
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CompactSingle" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSingleKES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSingleKES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSingleKES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CompactSum" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSum0KES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSum0KES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSum0KES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSum1KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSum1KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSum1KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSum2KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSum2KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSum2KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSum3KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSum3KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSum3KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSum4KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSum4KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSum4KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSum5KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSum5KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSum5KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSum6KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSum6KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSum6KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (CompactSum7KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (CompactSum7KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (CompactSum7KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Sum" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (Sum0KES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (Sum0KES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (Sum0KES Ed25519DSIGN)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (Sum1KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (Sum1KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (Sum1KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (Sum2KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (Sum2KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (Sum2KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (Sum3KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (Sum3KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (Sum3KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (Sum4KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (Sum4KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (Sum4KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (Sum5KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (Sum5KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (Sum5KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (Sum6KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (Sum7KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (Sum7KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (Sum7KES Ed25519DSIGN Blake2b_256)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        -- below we also test some tuple roundtripping as well as KES
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Simple" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec
            @( SignKeyKES (SimpleKES Ed25519DSIGN 1)
             , SignKeyKES (SimpleKES Ed25519DSIGN 2)
             , SignKeyKES (SimpleKES Ed25519DSIGN 3)
             , SignKeyKES (SimpleKES Ed25519DSIGN 4)
             , SignKeyKES (SimpleKES Ed25519DSIGN 5)
             , SignKeyKES (SimpleKES Ed25519DSIGN 6)
             )
            forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec
            @(SignKeyKES (SimpleKES Ed25519DSIGN 7))
            forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec
            @( VerKeyKES (SimpleKES Ed25519DSIGN 1)
             , VerKeyKES (SimpleKES Ed25519DSIGN 2)
             , VerKeyKES (SimpleKES Ed25519DSIGN 3)
             , VerKeyKES (SimpleKES Ed25519DSIGN 4)
             , VerKeyKES (SimpleKES Ed25519DSIGN 5)
             , VerKeyKES (SimpleKES Ed25519DSIGN 6)
             , VerKeyKES (SimpleKES Ed25519DSIGN 7)
             )
            forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec
            @( SigKES (SimpleKES Ed25519DSIGN 1)
             , SigKES (SimpleKES Ed25519DSIGN 2)
             , SigKES (SimpleKES Ed25519DSIGN 3)
             , SigKES (SimpleKES Ed25519DSIGN 4)
             )
            forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec
            @( SigKES (SimpleKES Ed25519DSIGN 5)
             , SigKES (SimpleKES Ed25519DSIGN 6)
             , SigKES (SimpleKES Ed25519DSIGN 7)
             )
            forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Mock" forall a b. (a -> b) -> a -> b
$ do
            forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SignKeyKES (MockKES 7)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
            forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(VerKeyKES (MockKES 7)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
            forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec @(SigKES (MockKES 7)) forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hash" forall a b. (a -> b) -> a -> b
$ do
          forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec
            @( Hash Blake2b_224 ()
             , Hash Blake2b_256 ()
             , Hash SHA256 ()
             , Hash SHA3_256 ()
             , Hash Keccak256 ()
             , Hash ShortHash ()
             )
            forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"EmbedTrip" forall a b. (a -> b) -> a -> b
$ do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version
shelleyProtVer .. forall a. Bounded a => a
maxBound] forall a b. (a -> b) -> a -> b
$ \Version
v ->
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall a. Show a => a -> String
show Version
v) forall a b. (a -> b) -> a -> b
$ do
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Word8 @Word16) forall a b. (a -> b) -> a -> b
$
          \Word16
n Word8
w -> Word16
n forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Word16 @Word32) forall a b. (a -> b) -> a -> b
$
          \Word32
n Word16
w -> Word32
n forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Word32 @Word64) forall a b. (a -> b) -> a -> b
$
          \Word64
n Word32
w -> Word64
n forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Word @Natural) forall a b. (a -> b) -> a -> b
$
          \Natural
n Word
w -> Natural
n forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Int8 @Int16) forall a b. (a -> b) -> a -> b
$
          \Int16
n Int8
w -> Int16
n forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
w
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Int16 @Int32) forall a b. (a -> b) -> a -> b
$
          \Int32
n Int16
w -> Int32
n forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
w
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Int32 @Int64) forall a b. (a -> b) -> a -> b
$
          \Int64
n Int32
w -> Int64
n forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
w
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Int @Integer) forall a b. (a -> b) -> a -> b
$
          \Integer
n Int
w -> Integer
n forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Int @(Tagged () Int)) forall a b. (a -> b) -> a -> b
$
          \(Tagged Int
i') Int
i -> Int
i' forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
i
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Maybe Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs Maybe Word
mx -> forall a. [a] -> Maybe a
listToMaybe [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Maybe Word
mx
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(StrictMaybe Word) @(Maybe Word)) forall a b. (a -> b) -> a -> b
$
          \Maybe Word
m StrictMaybe Word
sm -> Maybe Word
m forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Word
sm
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Maybe Word) @(StrictMaybe Word)) forall a b. (a -> b) -> a -> b
$
          \StrictMaybe Word
sm Maybe Word
m -> StrictMaybe Word
sm forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe Word
m
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Word, Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs (Word
x, Word
y) -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Word
x, Word
y]
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Word, Word, Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs (Word
x, Word
y, Word
z) -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Word
x, Word
y, Word
z]
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Word, Word, Word, Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs (Word
a, Word
b, Word
c, Word
d) -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Word
a, Word
b, Word
c, Word
d]
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Word, Word, Word, Word, Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs (Word
a, Word
b, Word
c, Word
d, Word
e) -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Word
a, Word
b, Word
c, Word
d, Word
e]
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Word, Word, Word, Word, Word, Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs (Word
a, Word
b, Word
c, Word
d, Word
e, Word
f) -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Word
a, Word
b, Word
c, Word
d, Word
e, Word
f]
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(VP.Vector Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs Vector Word
sxs -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a. Prim a => Vector a -> [a]
VP.toList Vector Word
sxs
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Seq.Seq Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs Seq Word
sxs -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Word
sxs
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(SSeq.StrictSeq Word) @[Word]) forall a b. (a -> b) -> a -> b
$
          \[Word]
xs StrictSeq Word
sxs -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList StrictSeq Word
sxs
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
v forall a. Ord a => a -> a -> Bool
< forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) forall a b. (a -> b) -> a -> b
$ do
          -- Starting with version 9 Set is prefixed with tag 258, which prevents it from
          -- being deserialized into a list.
          forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Set.Set Word) @[Word]) forall a b. (a -> b) -> a -> b
$
            \[Word]
xs Set Word
sxs -> [Word]
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a. Set a -> [a]
Set.toList Set Word
sxs
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(VMap.VMap VMap.VP VMap.VP Word Int) @(Map.Map Word Int)) forall a b. (a -> b) -> a -> b
$
          \Map Word Int
xs VMap VP VP Word Int
sxs -> Map Word Int
xs forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap VMap VP VP Word Int
sxs
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall a. Bounded a => a
minBound .. forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @8] forall a b. (a -> b) -> a -> b
$ \Version
v ->
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall a. Show a => a -> String
show Version
v) forall a b. (a -> b) -> a -> b
$ do
        forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @Rational @(Integer, Integer)) forall a b. (a -> b) -> a -> b
$
          \(Integer
x, Integer
y) Rational
r -> (Integer
x, Integer
y) forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` (forall a. Ratio a -> a
numerator Rational
r, forall a. Ratio a -> a
denominator Rational
r)