{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Chain.Common.CBOR (
  tests,
) where

import Cardano.Chain.Common (
  AddrAttributes (..),
  AddrSpendingData (..),
  AddrType (..),
  Attributes (..),
  BlockCount (..),
  ChainDifficulty (..),
  TxFeePolicy (..),
  TxSizeLinear (..),
  decodeAddressBase58,
  decodeCrcProtected,
  encodeAddressBase58,
  encodeCrcProtected,
  isRedeemAddress,
  mkAttributes,
  mkKnownLovelace,
  mkMerkleTree,
  mtRoot,
  rationalToLovelacePortion,
 )
import Cardano.Crypto (
  Hash,
  abstractHash,
  redeemDeterministicKeyGen,
 )
import Cardano.Crypto.Raw (Raw (..))
import Cardano.Ledger.Binary (
  Case (..),
  EncCBOR,
  SizeOverride (..),
  byronProtVer,
  decodeFullDecoder,
  serialize,
  szCases,
 )
import Cardano.Prelude hiding (check)
import qualified Data.Map as M
import Hedgehog (Gen, Property, cover, forAll, property, (===))
import qualified Hedgehog as H
import Test.Cardano.Chain.Common.Example (
  exampleAddrSpendingData_VerKey,
  exampleAddress,
  exampleAddress1,
  exampleAddress2,
  exampleAddress3,
  exampleAddress4,
  exampleKeyHash,
 )
import Test.Cardano.Chain.Common.Gen (
  genAddrAttributes,
  genAddrSpendingData,
  genAddrType,
  genAddress,
  genAttributes,
  genBlockCount,
  genChainDifficulty,
  genKeyHash,
  genLovelace,
  genLovelaceError,
  genLovelacePortion,
  genMerkleRoot,
  genMerkleTree,
  genTxFeePolicy,
  genTxSizeLinear,
 )
import Test.Cardano.Crypto.CBOR (getBytes)
import Test.Cardano.Crypto.Gen (genHashRaw)
import Test.Cardano.Ledger.Binary.Vintage.Helpers (SizeTestConfig (..), scfg, sizeTest)
import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (
  goldenTestCBOR,
  roundTripsCBORBuildable,
  roundTripsCBORShow,
 )
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS)

--------------------------------------------------------------------------------
-- CRC encoding
--------------------------------------------------------------------------------

prop_roundTripCrcProtected :: Property
prop_roundTripCrcProtected :: Property
prop_roundTripCrcProtected = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  Address
x <- Gen Address -> PropertyT IO Address
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Address
genAddress
  let crcEncodedBS :: ByteString
crcEncodedBS = Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer (Encoding -> ByteString)
-> (Address -> Encoding) -> Address -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> Encoding
forall a. EncCBOR a => a -> Encoding
encodeCrcProtected (Address -> ByteString) -> Address -> ByteString
forall a b. (a -> b) -> a -> b
$ Address
x
  Version
-> Text
-> (forall s. Decoder s Address)
-> ByteString
-> Either DecoderError Address
forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
byronProtVer Text
"" Decoder s Address
forall s. Decoder s Address
forall s a. DecCBOR a => Decoder s a
decodeCrcProtected ByteString
crcEncodedBS Either DecoderError Address
-> Either DecoderError Address -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Address -> Either DecoderError Address
forall a b. b -> Either a b
Right Address
x

--------------------------------------------------------------------------------
-- Address
--------------------------------------------------------------------------------
golden_Address0 :: Property
golden_Address0 :: Property
golden_Address0 = Address -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Address
exampleAddress FilePath
"golden/cbor/common/Address0"

golden_Address1 :: Property
golden_Address1 :: Property
golden_Address1 = Address -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Address
exampleAddress1 FilePath
"golden/cbor/common/Address1"

golden_Address2 :: Property
golden_Address2 :: Property
golden_Address2 = Address -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Address
exampleAddress2 FilePath
"golden/cbor/common/Address2"

golden_Address3 :: Property
golden_Address3 :: Property
golden_Address3 = Address -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Address
exampleAddress3 FilePath
"golden/cbor/common/Address3"

golden_Address4 :: Property
golden_Address4 :: Property
golden_Address4 = Address -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Address
exampleAddress4 FilePath
"golden/cbor/common/Address4"

golden_isRedeemAddrees :: Property
golden_isRedeemAddrees :: Property
golden_isRedeemAddrees =
  TestLimit -> Property -> Property
H.withTests TestLimit
1 (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Address -> Bool
isRedeemAddress Address
exampleAddress1)
    Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Address -> Bool
isRedeemAddress Address
exampleAddress2

ts_roundTripAddressCBOR :: TSProperty
ts_roundTripAddressCBOR :: TSProperty
ts_roundTripAddressCBOR = TestLimit
-> Gen Address -> (Address -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen Address
genAddress Address -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

ts_roundTripAddress :: TSProperty
ts_roundTripAddress :: TSProperty
ts_roundTripAddress =
  TestLimit
-> Gen Address -> (Address -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen Address
genAddress ((Address -> PropertyT IO ()) -> TSProperty)
-> (Address -> PropertyT IO ()) -> TSProperty
forall a b. (a -> b) -> a -> b
$ \Address
addr -> do
    CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
30 LabelName
"Redeem Address" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Address -> Bool
isRedeemAddress Address
addr
    CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
30 LabelName
"Pubkey Address" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Address -> Bool
isRedeemAddress Address
addr)
    Text -> Either DecoderError Address
decodeAddressBase58 (Address -> Text
encodeAddressBase58 Address
addr) Either DecoderError Address
-> Either DecoderError Address -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Address -> Either DecoderError Address
forall a b. b -> Either a b
Right Address
addr

--------------------------------------------------------------------------------
-- AddrSpendingData
--------------------------------------------------------------------------------
golden_AddrSpendingData_VerKey :: Property
golden_AddrSpendingData_VerKey :: Property
golden_AddrSpendingData_VerKey =
  AddrSpendingData -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR AddrSpendingData
exampleAddrSpendingData_VerKey FilePath
"golden/cbor/common/AddrSpendingData_VerKey"

golden_AddrSpendingData_Redeem :: Property
golden_AddrSpendingData_Redeem :: Property
golden_AddrSpendingData_Redeem = AddrSpendingData -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR AddrSpendingData
asd FilePath
"golden/cbor/common/AddrSpendingData_Redeem"
  where
    asd :: AddrSpendingData
asd = RedeemVerificationKey -> AddrSpendingData
RedeemASD RedeemVerificationKey
redeemVerificationKey
    redeemVerificationKey :: RedeemVerificationKey
redeemVerificationKey =
      case (RedeemVerificationKey, RedeemSigningKey) -> RedeemVerificationKey
forall a b. (a, b) -> a
fst ((RedeemVerificationKey, RedeemSigningKey)
 -> RedeemVerificationKey)
-> Maybe (RedeemVerificationKey, RedeemSigningKey)
-> Maybe RedeemVerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (RedeemVerificationKey, RedeemSigningKey)
redeemDeterministicKeyGen (Int -> Int -> ByteString
getBytes Int
0 Int
32) of
        Maybe RedeemVerificationKey
Nothing -> Text -> RedeemVerificationKey
forall a. HasCallStack => Text -> a
panic Text
"golden_AddrSpendingData_Redeem: impossible"
        Just RedeemVerificationKey
rk -> RedeemVerificationKey
rk

ts_roundTripAddrSpendingDataCBOR :: TSProperty
ts_roundTripAddrSpendingDataCBOR :: TSProperty
ts_roundTripAddrSpendingDataCBOR =
  TestLimit
-> Gen AddrSpendingData
-> (AddrSpendingData -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen AddrSpendingData
genAddrSpendingData AddrSpendingData -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- AddrType
--------------------------------------------------------------------------------
golden_AddrType_VK :: Property
golden_AddrType_VK :: Property
golden_AddrType_VK = AddrType -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR AddrType
ATVerKey FilePath
"golden/cbor/common/AddrType_VK"

golden_AddrType_R :: Property
golden_AddrType_R :: Property
golden_AddrType_R = AddrType -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR AddrType
ATRedeem FilePath
"golden/cbor/common/AddrType_R"

ts_roundTripAddrTypeCBOR :: TSProperty
ts_roundTripAddrTypeCBOR :: TSProperty
ts_roundTripAddrTypeCBOR = TestLimit
-> Gen AddrType -> (AddrType -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen AddrType
genAddrType AddrType -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- BlockCount
--------------------------------------------------------------------------------
golden_BlockCount :: Property
golden_BlockCount :: Property
golden_BlockCount = BlockCount -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR BlockCount
bc FilePath
"golden/cbor/common/BlockCount"
  where
    bc :: BlockCount
bc = Word64 -> BlockCount
BlockCount Word64
999

ts_roundTripBlockCountCBOR :: TSProperty
ts_roundTripBlockCountCBOR :: TSProperty
ts_roundTripBlockCountCBOR = TestLimit
-> Gen BlockCount -> (BlockCount -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen BlockCount
genBlockCount BlockCount -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- ChainDifficulty
--------------------------------------------------------------------------------
golden_ChainDifficulty :: Property
golden_ChainDifficulty :: Property
golden_ChainDifficulty = ChainDifficulty -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR ChainDifficulty
cd FilePath
"golden/cbor/common/ChainDifficulty"
  where
    cd :: ChainDifficulty
cd = Word64 -> ChainDifficulty
ChainDifficulty Word64
9999

ts_roundTripChainDifficultyCBOR :: TSProperty
ts_roundTripChainDifficultyCBOR :: TSProperty
ts_roundTripChainDifficultyCBOR =
  TestLimit
-> Gen ChainDifficulty
-> (ChainDifficulty -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen ChainDifficulty
genChainDifficulty ChainDifficulty -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- Lovelace
--------------------------------------------------------------------------------
golden_Lovelace :: Property
golden_Lovelace :: Property
golden_Lovelace = Lovelace -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Lovelace
c FilePath
"golden/cbor/common/Lovelace"
  where
    c :: Lovelace
c = forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @9732

ts_roundTripLovelaceCBOR :: TSProperty
ts_roundTripLovelaceCBOR :: TSProperty
ts_roundTripLovelaceCBOR = TestLimit
-> Gen Lovelace -> (Lovelace -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen Lovelace
genLovelace Lovelace -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- LovelaceError
--------------------------------------------------------------------------------
ts_roundTripLovelaceErrorCBOR :: TSProperty
ts_roundTripLovelaceErrorCBOR :: TSProperty
ts_roundTripLovelaceErrorCBOR =
  TestLimit
-> Gen LovelaceError
-> (LovelaceError -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen LovelaceError
genLovelaceError LovelaceError -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- LovelacePortion
--------------------------------------------------------------------------------
golden_LovelacePortion :: Property
golden_LovelacePortion :: Property
golden_LovelacePortion = LovelacePortion -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR LovelacePortion
c FilePath
"golden/cbor/common/LovelacePortion"
  where
    c :: LovelacePortion
c = Rational -> LovelacePortion
rationalToLovelacePortion Rational
9702e-15

ts_roundTripLovelacePortionCBOR :: TSProperty
ts_roundTripLovelacePortionCBOR :: TSProperty
ts_roundTripLovelacePortionCBOR =
  TestLimit
-> Gen LovelacePortion
-> (LovelacePortion -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen LovelacePortion
genLovelacePortion LovelacePortion -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- KeyHash
--------------------------------------------------------------------------------
golden_KeyHash :: Property
golden_KeyHash :: Property
golden_KeyHash = KeyHash -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR KeyHash
exampleKeyHash FilePath
"golden/cbor/common/KeyHash"

ts_roundTripKeyHashCBOR :: TSProperty
ts_roundTripKeyHashCBOR :: TSProperty
ts_roundTripKeyHashCBOR =
  TestLimit
-> Gen KeyHash -> (KeyHash -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen KeyHash
genKeyHash KeyHash -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxFeePolicy
--------------------------------------------------------------------------------
golden_TxFeePolicy_Linear :: Property
golden_TxFeePolicy_Linear :: Property
golden_TxFeePolicy_Linear = TxFeePolicy -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxFeePolicy
tfp FilePath
"golden/cbor/common/TxFeePolicy_Linear"
  where
    tfp :: TxFeePolicy
tfp = TxSizeLinear -> TxFeePolicy
TxFeePolicyTxSizeLinear (Lovelace -> Rational -> TxSizeLinear
TxSizeLinear Lovelace
c1 Rational
c2)
    c1 :: Lovelace
c1 = forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @99
    c2 :: Rational
c2 = Rational
777 :: Rational

ts_roundTripTxFeePolicyCBOR :: TSProperty
ts_roundTripTxFeePolicyCBOR :: TSProperty
ts_roundTripTxFeePolicyCBOR =
  TestLimit
-> Gen TxFeePolicy
-> (TxFeePolicy -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen TxFeePolicy
genTxFeePolicy TxFeePolicy -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxSizeLinear
--------------------------------------------------------------------------------
golden_TxSizeLinear :: Property
golden_TxSizeLinear :: Property
golden_TxSizeLinear = TxSizeLinear -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxSizeLinear
tsl FilePath
"golden/cbor/common/TxSizeLinear"
  where
    tsl :: TxSizeLinear
tsl = Lovelace -> Rational -> TxSizeLinear
TxSizeLinear Lovelace
c1 Rational
c2
    c1 :: Lovelace
c1 = forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @99
    c2 :: Rational
c2 = Rational
777 :: Rational

ts_roundTripTxSizeLinearCBOR :: TSProperty
ts_roundTripTxSizeLinearCBOR :: TSProperty
ts_roundTripTxSizeLinearCBOR =
  TestLimit
-> Gen TxSizeLinear
-> (TxSizeLinear -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen TxSizeLinear
genTxSizeLinear TxSizeLinear -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- Attributes
--------------------------------------------------------------------------------
golden_Attributes :: Property
golden_Attributes :: Property
golden_Attributes = Attributes () -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Attributes ()
attrib FilePath
"golden/cbor/common/Attributes"
  where
    attrib :: Attributes ()
attrib = () -> Attributes ()
forall h. h -> Attributes h
mkAttributes ()

ts_roundTripAttributes :: TSProperty
ts_roundTripAttributes :: TSProperty
ts_roundTripAttributes =
  TestLimit
-> Gen (Attributes ())
-> (Attributes () -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 (Gen () -> Gen (Attributes ())
forall a. Gen a -> Gen (Attributes a)
genAttributes (() -> Gen ()
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) Attributes () -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- MerkleTree
--------------------------------------------------------------------------------
golden_MerkleTree :: Property
golden_MerkleTree :: Property
golden_MerkleTree = MerkleTree (Hash Raw) -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR MerkleTree (Hash Raw)
mTree FilePath
"golden/cbor/common/MerkleTree"
  where
    mTree :: MerkleTree (Hash Raw)
mTree = [Hash Raw] -> MerkleTree (Hash Raw)
forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree [(Raw -> Hash Raw
forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash (Raw -> Hash Raw) -> Raw -> Hash Raw
forall a b. (a -> b) -> a -> b
$ ByteString -> Raw
Raw (ByteString
"9") :: Hash Raw)]

ts_roundTripMerkleTree :: TSProperty
ts_roundTripMerkleTree :: TSProperty
ts_roundTripMerkleTree =
  TestLimit
-> Gen (MerkleTree (Hash Raw))
-> (MerkleTree (Hash Raw) -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
10 (Gen (Hash Raw) -> Gen (MerkleTree (Hash Raw))
forall a. EncCBOR a => Gen a -> Gen (MerkleTree a)
genMerkleTree Gen (Hash Raw)
genHashRaw) MerkleTree (Hash Raw) -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- MerkleRoot
--------------------------------------------------------------------------------
golden_MerkleRoot :: Property
golden_MerkleRoot :: Property
golden_MerkleRoot = MerkleRoot (Hash Raw) -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR MerkleRoot (Hash Raw)
mTree FilePath
"golden/cbor/common/MerkleRoot"
  where
    mTree :: MerkleRoot (Hash Raw)
mTree = MerkleTree (Hash Raw) -> MerkleRoot (Hash Raw)
forall a. MerkleTree a -> MerkleRoot a
mtRoot (MerkleTree (Hash Raw) -> MerkleRoot (Hash Raw))
-> MerkleTree (Hash Raw) -> MerkleRoot (Hash Raw)
forall a b. (a -> b) -> a -> b
$ [Hash Raw] -> MerkleTree (Hash Raw)
forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree [(Raw -> Hash Raw
forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash (Raw -> Hash Raw) -> Raw -> Hash Raw
forall a b. (a -> b) -> a -> b
$ ByteString -> Raw
Raw (ByteString
"9") :: Hash Raw)]

ts_roundTripMerkleRoot :: TSProperty
ts_roundTripMerkleRoot :: TSProperty
ts_roundTripMerkleRoot =
  TestLimit
-> Gen (MerkleRoot (Hash Raw))
-> (MerkleRoot (Hash Raw) -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
10 (Gen (Hash Raw) -> Gen (MerkleRoot (Hash Raw))
forall a. EncCBOR a => Gen a -> Gen (MerkleRoot a)
genMerkleRoot Gen (Hash Raw)
genHashRaw) MerkleRoot (Hash Raw) -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- Size estimates
--------------------------------------------------------------------------------
sizeEstimates :: H.Group
sizeEstimates :: Group
sizeEstimates =
  let check :: forall a. (Show a, EncCBOR a) => Gen a -> Property
      check :: forall a. (Show a, EncCBOR a) => Gen a -> Property
check Gen a
g = SizeTestConfig a -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest (SizeTestConfig a -> Property) -> SizeTestConfig a -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig a
forall a. Show a => SizeTestConfig a
scfg {gen = g}

      -- Explicit bounds for types, based on the generators from Gen.
      attrUnitSize :: (TypeRep, SizeOverride)
attrUnitSize =
        ( Proxy (Attributes ()) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Attributes ()))
        , Size -> SizeOverride
SizeConstant Size
1
        )
      attrAddrSize :: (TypeRep, SizeOverride)
attrAddrSize =
        ( Proxy (Attributes AddrAttributes) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Attributes AddrAttributes))
        , Size -> SizeOverride
SizeConstant ([Case Size] -> Size
szCases [Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"min" Size
1, Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"max" Size
1024])
        )
   in GroupName -> [(PropertyName, Property)] -> Group
H.Group
        GroupName
"Encoded size bounds for core types."
        [ (PropertyName
"Lovelace", Gen Lovelace -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
check Gen Lovelace
genLovelace)
        , (PropertyName
"BlockCount", Gen BlockCount -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
check Gen BlockCount
genBlockCount)
        ,
          ( PropertyName
"Attributes ()"
          , SizeTestConfig (Attributes ()) -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig (Attributes ()) -> Property)
-> SizeTestConfig (Attributes ()) -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig (Attributes ())
forall a. Show a => SizeTestConfig a
scfg
                { gen = genAttributes (pure ())
                , addlCtx = M.fromList [attrUnitSize]
                }
          )
        ,
          ( PropertyName
"Attributes AddrAttributes"
          , SizeTestConfig (Attributes AddrAttributes) -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig (Attributes AddrAttributes) -> Property)
-> SizeTestConfig (Attributes AddrAttributes) -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig (Attributes AddrAttributes)
forall a. Show a => SizeTestConfig a
scfg
                { gen = genAttributes genAddrAttributes
                , addlCtx = M.fromList [attrAddrSize]
                }
          )
        ,
          ( PropertyName
"Address"
          , SizeTestConfig Address -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig Address -> Property)
-> SizeTestConfig Address -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig Address
forall a. Show a => SizeTestConfig a
scfg
                { gen = genAddress
                , addlCtx = M.fromList [attrAddrSize]
                }
          )
        ,
          ( PropertyName
"AddrSpendingData"
          , SizeTestConfig AddrSpendingData -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig AddrSpendingData -> Property)
-> SizeTestConfig AddrSpendingData -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig AddrSpendingData
forall a. Show a => SizeTestConfig a
scfg
                { gen = genAddrSpendingData
                , addlCtx =
                    M.fromList
                      [
                        ( typeRep (Proxy @AddrSpendingData)
                        , SelectCases ["VerKeyASD", "RedeemASD"]
                        )
                      ]
                }
          )
        , (PropertyName
"AddrType", Gen AddrType -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
check Gen AddrType
genAddrType)
        ]

--------------------------------------------------------------------------------
-- Main test export
--------------------------------------------------------------------------------

tests :: TSGroup
tests :: TSGroup
tests =
  [TSGroup] -> TSGroup
concatTSGroups
    [Group -> TSGroup
forall a b. a -> b -> a
const $$FilePath
[(PropertyName, Property)]
Property
FilePath -> GroupName
FilePath -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
golden_Address0 :: Property
golden_Address1 :: Property
golden_Address2 :: Property
golden_Address3 :: Property
golden_Address4 :: Property
golden_isRedeemAddrees :: Property
golden_AddrSpendingData_VerKey :: Property
golden_AddrSpendingData_Redeem :: Property
golden_AddrType_VK :: Property
golden_AddrType_R :: Property
golden_BlockCount :: Property
golden_ChainDifficulty :: Property
golden_Lovelace :: Property
golden_LovelacePortion :: Property
golden_KeyHash :: Property
golden_TxFeePolicy_Linear :: Property
golden_TxSizeLinear :: Property
golden_Attributes :: Property
golden_MerkleTree :: Property
golden_MerkleRoot :: Property
discoverGolden, $$discoverRoundTripArg, Group -> TSGroup
forall a b. a -> b -> a
const Group
sizeEstimates]