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

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

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

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

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

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

golden_isRedeemAddrees :: Property
golden_isRedeemAddrees :: Property
golden_isRedeemAddrees =
  TestLimit -> Property -> Property
H.withTests TestLimit
1 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
property forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Address -> Bool
isRedeemAddress Address
exampleAddress1)
    forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert forall a b. (a -> b) -> a -> b
$ Address -> Bool
isRedeemAddress Address
exampleAddress2

ts_roundTripAddressCBOR :: TSProperty
ts_roundTripAddressCBOR :: TSProperty
ts_roundTripAddressCBOR = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen Address
genAddress 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 =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen Address
genAddress forall a b. (a -> b) -> a -> b
$ \Address
addr -> do
    forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
30 LabelName
"Redeem Address" forall a b. (a -> b) -> a -> b
$ Address -> Bool
isRedeemAddress Address
addr
    forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
30 LabelName
"Pubkey Address" 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) forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall a b. b -> Either a b
Right Address
addr

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

golden_AddrSpendingData_Redeem :: Property
golden_AddrSpendingData_Redeem :: Property
golden_AddrSpendingData_Redeem =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR AddrSpendingData
asd (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/AddrSpendingData_Redeem"
  where
    asd :: AddrSpendingData
asd = RedeemVerificationKey -> AddrSpendingData
RedeemASD RedeemVerificationKey
redeemVerificationKey
    redeemVerificationKey :: RedeemVerificationKey
redeemVerificationKey =
      case forall a b. (a, b) -> a
fst 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 -> forall a. HasCallStack => Text -> a
panic Text
"golden_AddrSpendingData_Redeem: impossible"
        Just RedeemVerificationKey
rk -> RedeemVerificationKey
rk

ts_roundTripAddrSpendingDataCBOR :: TSProperty
ts_roundTripAddrSpendingDataCBOR :: TSProperty
ts_roundTripAddrSpendingDataCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen AddrSpendingData
genAddrSpendingData 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 = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR AddrType
ATVerKey (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/AddrType_VK"

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

ts_roundTripAddrTypeCBOR :: TSProperty
ts_roundTripAddrTypeCBOR :: TSProperty
ts_roundTripAddrTypeCBOR = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen AddrType
genAddrType 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 = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR BlockCount
bc (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/BlockCount"
  where
    bc :: BlockCount
bc = Word64 -> BlockCount
BlockCount Word64
999

ts_roundTripBlockCountCBOR :: TSProperty
ts_roundTripBlockCountCBOR :: TSProperty
ts_roundTripBlockCountCBOR = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen BlockCount
genBlockCount 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 =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR ChainDifficulty
cd (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/ChainDifficulty"
  where
    cd :: ChainDifficulty
cd = Word64 -> ChainDifficulty
ChainDifficulty Word64
9999

ts_roundTripChainDifficultyCBOR :: TSProperty
ts_roundTripChainDifficultyCBOR :: TSProperty
ts_roundTripChainDifficultyCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen ChainDifficulty
genChainDifficulty 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 = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Lovelace
c (FilePath -> Property) -> FilePath -> Property
<:< 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 = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen Lovelace
genLovelace 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 =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen LovelaceError
genLovelaceError 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 =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR LovelacePortion
c (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/LovelacePortion"
  where
    c :: LovelacePortion
c = Rational -> LovelacePortion
rationalToLovelacePortion Rational
9702e-15

ts_roundTripLovelacePortionCBOR :: TSProperty
ts_roundTripLovelacePortionCBOR :: TSProperty
ts_roundTripLovelacePortionCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen LovelacePortion
genLovelacePortion 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 =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR KeyHash
exampleKeyHash (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/KeyHash"

ts_roundTripKeyHashCBOR :: TSProperty
ts_roundTripKeyHashCBOR :: TSProperty
ts_roundTripKeyHashCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen KeyHash
genKeyHash 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 =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxFeePolicy
tfp (FilePath -> Property) -> FilePath -> Property
<:< 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 =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen TxFeePolicy
genTxFeePolicy 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 =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxSizeLinear
tsl (FilePath -> Property) -> FilePath -> Property
<:< 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 =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen TxSizeLinear
genTxSizeLinear 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 = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Attributes ()
attrib (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/Attributes"
  where
    attrib :: Attributes ()
attrib = forall h. h -> Attributes h
mkAttributes ()

ts_roundTripAttributes :: TSProperty
ts_roundTripAttributes :: TSProperty
ts_roundTripAttributes =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 (forall a. Gen a -> Gen (Attributes a)
genAttributes (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) 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 = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR MerkleTree (Hash Raw)
mTree (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/MerkleTree"
  where
    mTree :: MerkleTree (Hash Raw)
mTree = forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree [(forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash forall a b. (a -> b) -> a -> b
$ ByteString -> Raw
Raw (ByteString
"9") :: Hash Raw)]

ts_roundTripMerkleTree :: TSProperty
ts_roundTripMerkleTree :: TSProperty
ts_roundTripMerkleTree =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
10 (forall a. EncCBOR a => Gen a -> Gen (MerkleTree a)
genMerkleTree Gen (Hash Raw)
genHashRaw) 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 = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR MerkleRoot (Hash Raw)
mTree (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/common/MerkleRoot"
  where
    mTree :: MerkleRoot (Hash Raw)
mTree = forall a. MerkleTree a -> MerkleRoot a
mtRoot forall a b. (a -> b) -> a -> b
$ forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree [(forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash forall a b. (a -> b) -> a -> b
$ ByteString -> Raw
Raw (ByteString
"9") :: Hash Raw)]

ts_roundTripMerkleRoot :: TSProperty
ts_roundTripMerkleRoot :: TSProperty
ts_roundTripMerkleRoot =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
10 (forall a. EncCBOR a => Gen a -> Gen (MerkleRoot a)
genMerkleRoot Gen (Hash Raw)
genHashRaw) 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 = forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest forall a b. (a -> b) -> a -> b
$ forall a. Show a => SizeTestConfig a
scfg {gen :: Gen a
gen = Gen a
g}

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

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

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