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

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

import Cardano.Chain.Common (AddrAttributes (..), Attributes (..), mkAttributes)
import Cardano.Chain.UTxO (
  Tx (..),
  TxIn (..),
  TxInWitness (..),
  TxOut (..),
  TxSigData (..),
  taTx,
  taWitness,
 )
import Cardano.Crypto (ProtocolMagicId (..), SignTag (..), Signature, sign)
import Cardano.Ledger.Binary (Case (..), EncCBOR, LengthOf, SizeOverride (..), szCases)
import Cardano.Prelude
import qualified Data.Map.Strict as M
import Data.Vector (Vector)
import Hedgehog (Gen, Property)
import qualified Hedgehog as H
import Test.Cardano.Chain.UTxO.Example (
  exampleHashTx,
  exampleRedeemSignature,
  exampleTxId,
  exampleTxInList,
  exampleTxInUtxo,
  exampleTxOut,
  exampleTxOut1,
  exampleTxOutList,
  exampleTxPayload1,
  exampleTxProof,
  exampleTxSig,
  exampleTxSigData,
  exampleTxWitness,
 )
import Test.Cardano.Chain.UTxO.Gen (
  genTx,
  genTxAttributes,
  genTxAux,
  genTxHash,
  genTxId,
  genTxIn,
  genTxInList,
  genTxInWitness,
  genTxOut,
  genTxOutList,
  genTxPayload,
  genTxProof,
  genTxSig,
  genTxSigData,
  genTxValidationError,
  genTxWitness,
  genUTxOConfiguration,
  genUTxOError,
  genUTxOValidationError,
 )
import Test.Cardano.Crypto.Example (
  exampleRedeemVerificationKey,
  exampleSigningKey,
  exampleVerificationKey,
 )
import Test.Cardano.Crypto.Gen (feedPM)
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)

--------------------------------------------------------------------------------
-- Tx
--------------------------------------------------------------------------------

goldenTx :: Property
goldenTx :: Property
goldenTx = Tx -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Tx
tx FilePath
"golden/cbor/utxo/Tx"
  where
    tx :: Tx
tx = NonEmpty TxIn -> NonEmpty TxOut -> TxAttributes -> Tx
UnsafeTx NonEmpty TxIn
exampleTxInList NonEmpty TxOut
exampleTxOutList (() -> TxAttributes
forall h. h -> Attributes h
mkAttributes ())

ts_roundTripTx :: TSProperty
ts_roundTripTx :: TSProperty
ts_roundTripTx = TestLimit -> Gen Tx -> (Tx -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen Tx
genTx Tx -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxAttributes
--------------------------------------------------------------------------------

goldenTxAttributes :: Property
goldenTxAttributes :: Property
goldenTxAttributes = TxAttributes -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxAttributes
txA FilePath
"golden/cbor/utxo/TxAttributes"
  where
    txA :: TxAttributes
txA = () -> TxAttributes
forall h. h -> Attributes h
mkAttributes ()

ts_roundTripTxAttributes :: TSProperty
ts_roundTripTxAttributes :: TSProperty
ts_roundTripTxAttributes = TestLimit
-> Gen TxAttributes
-> (TxAttributes -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
10 Gen TxAttributes
genTxAttributes TxAttributes -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxAux
--------------------------------------------------------------------------------

ts_roundTripTxAux :: TSProperty
ts_roundTripTxAux :: TSProperty
ts_roundTripTxAux = TestLimit -> Gen TxAux -> (TxAux -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 ((ProtocolMagicId -> Gen TxAux) -> Gen TxAux
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen TxAux
genTxAux) TxAux -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- Tx Hash
--------------------------------------------------------------------------------

goldenHashTx :: Property
goldenHashTx :: Property
goldenHashTx = TxId -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxId
exampleHashTx FilePath
"golden/cbor/utxo/HashTx"

ts_roundTripHashTx :: TSProperty
ts_roundTripHashTx :: TSProperty
ts_roundTripHashTx = TestLimit -> Gen TxId -> (TxId -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen TxId
genTxHash TxId -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxIn
--------------------------------------------------------------------------------

goldenTxInUtxo :: Property
goldenTxInUtxo :: Property
goldenTxInUtxo = TxIn -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxIn
exampleTxInUtxo FilePath
"golden/cbor/utxo/TxIn_Utxo"

ts_roundTripTxIn :: TSProperty
ts_roundTripTxIn :: TSProperty
ts_roundTripTxIn = TestLimit -> Gen TxIn -> (TxIn -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen TxIn
genTxIn TxIn -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxId
--------------------------------------------------------------------------------

goldenTxId :: Property
goldenTxId :: Property
goldenTxId = TxId -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxId
exampleTxId FilePath
"golden/cbor/utxo/TxId"

ts_roundTripTxId :: TSProperty
ts_roundTripTxId :: TSProperty
ts_roundTripTxId = TestLimit -> Gen TxId -> (TxId -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen TxId
genTxId TxId -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxInList
--------------------------------------------------------------------------------

goldenTxInList :: Property
goldenTxInList :: Property
goldenTxInList = NonEmpty TxIn -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR NonEmpty TxIn
exampleTxInList FilePath
"golden/cbor/utxo/TxInList"

ts_roundTripTxInList :: TSProperty
ts_roundTripTxInList :: TSProperty
ts_roundTripTxInList = TestLimit
-> Gen (NonEmpty TxIn)
-> (NonEmpty TxIn -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen (NonEmpty TxIn)
genTxInList NonEmpty TxIn -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- TxInWitness
--------------------------------------------------------------------------------

goldenVKWitness :: Property
goldenVKWitness :: Property
goldenVKWitness = TxInWitness -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxInWitness
vkWitness FilePath
"golden/cbor/utxo/TxInWitness_VKWitness"
  where
    vkWitness :: TxInWitness
vkWitness = VerificationKey -> TxSig -> TxInWitness
VKWitness VerificationKey
exampleVerificationKey TxSig
exampleTxSig

goldenRedeemWitness :: Property
goldenRedeemWitness :: Property
goldenRedeemWitness = TxInWitness -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxInWitness
redeemWitness FilePath
"golden/cbor/utxo/TxInWitness_RedeemWitness"
  where
    redeemWitness :: TxInWitness
redeemWitness = RedeemVerificationKey -> RedeemSignature TxSigData -> TxInWitness
RedeemWitness RedeemVerificationKey
exampleRedeemVerificationKey RedeemSignature TxSigData
exampleRedeemSignature

ts_roundTripTxInWitness :: TSProperty
ts_roundTripTxInWitness :: TSProperty
ts_roundTripTxInWitness =
  TestLimit
-> Gen TxInWitness
-> (TxInWitness -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 ((ProtocolMagicId -> Gen TxInWitness) -> Gen TxInWitness
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen TxInWitness
genTxInWitness) TxInWitness -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxOutList
--------------------------------------------------------------------------------

goldenTxOutList :: Property
goldenTxOutList :: Property
goldenTxOutList = NonEmpty TxOut -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR NonEmpty TxOut
exampleTxOutList FilePath
"golden/cbor/utxo/TxOutList"

ts_roundTripTxOutList :: TSProperty
ts_roundTripTxOutList :: TSProperty
ts_roundTripTxOutList = TestLimit
-> Gen (NonEmpty TxOut)
-> (NonEmpty TxOut -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen (NonEmpty TxOut)
genTxOutList NonEmpty TxOut -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- TxOut
--------------------------------------------------------------------------------

goldenTxOut :: Property
goldenTxOut :: Property
goldenTxOut = TxOut -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxOut
exampleTxOut FilePath
"golden/cbor/utxo/TxOut"

goldenTxOut1 :: Property
goldenTxOut1 :: Property
goldenTxOut1 = TxOut -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxOut
exampleTxOut1 FilePath
"golden/cbor/utxo/TxOut1"

ts_roundTripTxOut :: TSProperty
ts_roundTripTxOut :: TSProperty
ts_roundTripTxOut = TestLimit -> Gen TxOut -> (TxOut -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen TxOut
genTxOut TxOut -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxPayload
--------------------------------------------------------------------------------

goldenTxPayload1 :: Property
goldenTxPayload1 :: Property
goldenTxPayload1 = TxPayload -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxPayload
exampleTxPayload1 FilePath
"golden/cbor/utxo/TxPayload1"

ts_roundTripTxPayload :: TSProperty
ts_roundTripTxPayload :: TSProperty
ts_roundTripTxPayload = TestLimit
-> Gen TxPayload -> (TxPayload -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 ((ProtocolMagicId -> Gen TxPayload) -> Gen TxPayload
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen TxPayload
genTxPayload) TxPayload -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- TxProof
--------------------------------------------------------------------------------

goldenTxProof :: Property
goldenTxProof :: Property
goldenTxProof = TxProof -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxProof
exampleTxProof FilePath
"golden/cbor/utxo/TxProof"

ts_roundTripTxProof :: TSProperty
ts_roundTripTxProof :: TSProperty
ts_roundTripTxProof = TestLimit
-> Gen TxProof -> (TxProof -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 ((ProtocolMagicId -> Gen TxProof) -> Gen TxProof
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen TxProof
genTxProof) TxProof -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxSig
--------------------------------------------------------------------------------

goldenTxSig :: Property
goldenTxSig :: Property
goldenTxSig = TxSig -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxSig
txSigGold FilePath
"golden/cbor/utxo/TxSig"
  where
    txSigGold :: TxSig
txSigGold =
      ProtocolMagicId -> SignTag -> SigningKey -> TxSigData -> TxSig
forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign
        (Word32 -> ProtocolMagicId
ProtocolMagicId Word32
0)
        SignTag
SignForTestingOnly
        SigningKey
exampleSigningKey
        TxSigData
exampleTxSigData

ts_roundTripTxSig :: TSProperty
ts_roundTripTxSig :: TSProperty
ts_roundTripTxSig = TestLimit -> Gen TxSig -> (TxSig -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 ((ProtocolMagicId -> Gen TxSig) -> Gen TxSig
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen TxSig
genTxSig) TxSig -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- TxSigData
--------------------------------------------------------------------------------

goldenTxSigData :: Property
goldenTxSigData :: Property
goldenTxSigData = TxSigData -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR TxSigData
exampleTxSigData FilePath
"golden/cbor/utxo/TxSigData"

ts_roundTripTxSigData :: TSProperty
ts_roundTripTxSigData :: TSProperty
ts_roundTripTxSigData = TestLimit
-> Gen TxSigData -> (TxSigData -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen TxSigData
genTxSigData TxSigData -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- TxValidationError
--------------------------------------------------------------------------------

ts_roundTripTxValidationError :: TSProperty
ts_roundTripTxValidationError :: TSProperty
ts_roundTripTxValidationError =
  TestLimit
-> Gen TxValidationError
-> (TxValidationError -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen TxValidationError
genTxValidationError TxValidationError -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- TxWitness
--------------------------------------------------------------------------------

goldenTxWitness :: Property
goldenTxWitness :: Property
goldenTxWitness = Vector TxInWitness -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Vector TxInWitness
exampleTxWitness FilePath
"golden/cbor/utxo/TxWitness"

ts_roundTripTxWitness :: TSProperty
ts_roundTripTxWitness :: TSProperty
ts_roundTripTxWitness = TestLimit
-> Gen (Vector TxInWitness)
-> (Vector TxInWitness -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 ((ProtocolMagicId -> Gen (Vector TxInWitness))
-> Gen (Vector TxInWitness)
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen (Vector TxInWitness)
genTxWitness) Vector TxInWitness -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- UtxOError
--------------------------------------------------------------------------------

ts_roundTripUTxOError :: TSProperty
ts_roundTripUTxOError :: TSProperty
ts_roundTripUTxOError =
  TestLimit
-> Gen UTxOError -> (UTxOError -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen UTxOError
genUTxOError UTxOError -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- UTxOValidationError
--------------------------------------------------------------------------------

ts_roundTripUTxOValidationError :: TSProperty
ts_roundTripUTxOValidationError :: TSProperty
ts_roundTripUTxOValidationError =
  TestLimit
-> Gen UTxOValidationError
-> (UTxOValidationError -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen UTxOValidationError
genUTxOValidationError UTxOValidationError -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- UTxOConfiguration
--------------------------------------------------------------------------------

ts_roundTripUTxOConfiguration :: TSProperty
ts_roundTripUTxOConfiguration :: TSProperty
ts_roundTripUTxOConfiguration =
  TestLimit
-> Gen UTxOConfiguration
-> (UTxOConfiguration -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
500 Gen UTxOConfiguration
genUTxOConfiguration UTxOConfiguration -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- Size Estimates
--------------------------------------------------------------------------------

sizeEstimates :: H.Group
sizeEstimates :: Group
sizeEstimates =
  let sizeTestGen :: (Show a, EncCBOR a) => Gen a -> Property
      sizeTestGen :: forall a. (Show a, EncCBOR a) => Gen a -> Property
sizeTestGen 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}
      pm :: ProtocolMagicId
pm = Word32 -> ProtocolMagicId
ProtocolMagicId Word32
0

      -- Explicit bounds for types, based on the generators from Gen.
      attrUnitSize :: (TypeRep, SizeOverride)
attrUnitSize = (Proxy TxAttributes -> 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])
        )
      txSigSize :: (TypeRep, SizeOverride)
txSigSize = (Proxy TxSig -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Signature TxSigData)), Size -> SizeOverride
SizeConstant Size
66)
   in GroupName -> [(PropertyName, Property)] -> Group
H.Group
        GroupName
"Encoded size bounds for core types."
        [ (PropertyName
"TxId", Gen TxId -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
sizeTestGen Gen TxId
genTxId)
        ,
          ( PropertyName
"Tx"
          , SizeTestConfig Tx -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig Tx -> Property) -> SizeTestConfig Tx -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig Tx
forall a. Show a => SizeTestConfig a
scfg
                { gen = genTx
                , addlCtx = M.fromList [attrUnitSize, attrAddrSize]
                , computedCtx = \Tx
tx ->
                    [(TypeRep, SizeOverride)] -> Map TypeRep SizeOverride
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                      [
                        ( Proxy (LengthOf [TxIn]) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(LengthOf [TxIn]))
                        , Size -> SizeOverride
SizeConstant (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ NonEmpty TxIn -> Int
forall a. HasLength a => a -> Int
length (NonEmpty TxIn -> Int) -> NonEmpty TxIn -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> NonEmpty TxIn
txInputs Tx
tx)
                        )
                      ,
                        ( Proxy (LengthOf [TxOut]) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(LengthOf [TxOut]))
                        , Size -> SizeOverride
SizeConstant (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ NonEmpty TxOut -> Int
forall a. HasLength a => a -> Int
length (NonEmpty TxOut -> Int) -> NonEmpty TxOut -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> NonEmpty TxOut
txOutputs Tx
tx)
                        )
                      ]
                }
          )
        , (PropertyName
"TxIn", Gen TxIn -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
sizeTestGen Gen TxIn
genTxIn)
        ,
          ( PropertyName
"TxOut"
          , SizeTestConfig TxOut -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig TxOut -> Property)
-> SizeTestConfig TxOut -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig TxOut
forall a. Show a => SizeTestConfig a
scfg {gen = genTxOut, addlCtx = M.fromList [attrAddrSize]}
          )
        ,
          ( PropertyName
"TxAux"
          , SizeTestConfig TxAux -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig TxAux -> Property)
-> SizeTestConfig TxAux -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig TxAux
forall a. Show a => SizeTestConfig a
scfg
                { gen = genTxAux pm
                , addlCtx = M.fromList [attrUnitSize, attrAddrSize, txSigSize]
                , computedCtx = \TxAux
ta ->
                    [(TypeRep, SizeOverride)] -> Map TypeRep SizeOverride
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                      [
                        ( Proxy (LengthOf [TxIn]) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(LengthOf [TxIn]))
                        , Size -> SizeOverride
SizeConstant (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ NonEmpty TxIn -> Int
forall a. HasLength a => a -> Int
length (NonEmpty TxIn -> Int) -> NonEmpty TxIn -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> NonEmpty TxIn
txInputs (Tx -> NonEmpty TxIn) -> Tx -> NonEmpty TxIn
forall a b. (a -> b) -> a -> b
$ TxAux -> Tx
forall a. ATxAux a -> Tx
taTx TxAux
ta)
                        )
                      ,
                        ( Proxy (LengthOf (Vector TxInWitness)) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(LengthOf (Vector TxInWitness)))
                        , Size -> SizeOverride
SizeConstant (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ Vector TxInWitness -> Int
forall a. HasLength a => a -> Int
length (Vector TxInWitness -> Int) -> Vector TxInWitness -> Int
forall a b. (a -> b) -> a -> b
$ TxAux -> Vector TxInWitness
forall a. ATxAux a -> Vector TxInWitness
taWitness TxAux
ta)
                        )
                      ,
                        ( Proxy (LengthOf [TxOut]) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(LengthOf [TxOut]))
                        , Size -> SizeOverride
SizeConstant (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ NonEmpty TxOut -> Int
forall a. HasLength a => a -> Int
length (NonEmpty TxOut -> Int) -> NonEmpty TxOut -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> NonEmpty TxOut
txOutputs (Tx -> NonEmpty TxOut) -> Tx -> NonEmpty TxOut
forall a b. (a -> b) -> a -> b
$ TxAux -> Tx
forall a. ATxAux a -> Tx
taTx TxAux
ta)
                        )
                      ]
                }
          )
        ,
          ( PropertyName
"TxInWitness"
          , SizeTestConfig TxInWitness -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig TxInWitness -> Property)
-> SizeTestConfig TxInWitness -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig TxInWitness
forall a. Show a => SizeTestConfig a
scfg {gen = genTxInWitness pm, addlCtx = M.fromList [txSigSize]}
          )
        , (PropertyName
"TxSigData", Gen TxSigData -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
sizeTestGen Gen TxSigData
genTxSigData)
        ,
          ( PropertyName
"Signature TxSigData"
          , SizeTestConfig TxSig -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest
              (SizeTestConfig TxSig -> Property)
-> SizeTestConfig TxSig -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig TxSig
forall a. Show a => SizeTestConfig a
scfg {gen = genTxSig pm, addlCtx = M.fromList [txSigSize]}
          )
        ]

--------------------------------------------------------------------------------
-- 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
goldenTx :: Property
goldenTxAttributes :: Property
goldenHashTx :: Property
goldenTxInUtxo :: Property
goldenTxId :: Property
goldenTxInList :: Property
goldenVKWitness :: Property
goldenRedeemWitness :: Property
goldenTxOutList :: Property
goldenTxOut :: Property
goldenTxOut1 :: Property
goldenTxPayload1 :: Property
goldenTxProof :: Property
goldenTxSig :: Property
goldenTxSigData :: Property
goldenTxWitness :: Property
discoverGolden, $$discoverRoundTripArg, Group -> TSGroup
forall a b. a -> b -> a
const Group
sizeEstimates]