{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Byron.Spec.Ledger.AbstractSize.Properties (testTxHasTypeReps, testProperty) where
import Byron.Spec.Ledger.Core hiding ((<|))
import Byron.Spec.Ledger.STS.UTXOW (UTXOW)
import Byron.Spec.Ledger.UTxO
import Data.AbstractSize
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Sequence (empty, (<|), (><))
import qualified Data.Sequence as Seq
import Data.Typeable (TypeRep, Typeable, typeOf)
import Hedgehog (MonadTest, Property, forAll, property, withTests, (===))
import Hedgehog.Internal.Property (PropertyName (..))
import Numeric.Natural (Natural)
import Test.Control.State.Transition.Generator (trace)
import Test.Control.State.Transition.Trace (TraceOrder (OldestFirst), traceSignals)
import Test.Tasty (TestName, TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))
import Test.Tasty.Hedgehog hiding (testProperty)
testProperty :: TestName -> Property -> TestTree
testProperty :: TestName -> Property -> TestTree
testProperty TestName
s Property
p = TestName -> PropertyName -> Property -> TestTree
testPropertyNamed TestName
s (TestName -> PropertyName
Hedgehog.Internal.Property.PropertyName TestName
s) Property
p
aTx :: TxBody
aTx :: TxBody
aTx = forall a. HasCallStack => a
undefined
aTxId :: TxId
aTxId :: TxId
aTxId = Hash -> TxId
TxId (forall a. HasHash a => a -> Hash
hash TxBody
aTx)
exampleTypeRepsTxIn :: Assertion
exampleTypeRepsTxIn :: Assertion
exampleTypeRepsTxIn =
let txIn :: TxIn
txIn = TxId -> Natural -> TxIn
TxIn TxId
aTxId Natural
0
in forall a. HasTypeReps a => a -> Seq TypeRep
typeReps TxIn
txIn
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: TxIn)
forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: TxId)
forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Hash)
forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Maybe Int)
forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Int)
forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Natural)
forall a. a -> Seq a -> Seq a
<| forall a. Seq a
empty
exampleTypeRepsTx :: Assertion
exampleTypeRepsTx :: Assertion
exampleTypeRepsTx =
let (TxIn
in0, TxIn
in1) = (TxId -> Natural -> TxIn
TxIn TxId
aTxId Natural
0, TxId -> Natural -> TxIn
TxIn TxId
aTxId Natural
1)
outs :: [a]
outs = []
wits :: [a]
wits = []
tx :: Tx
tx = TxBody -> [Wit] -> Tx
Tx ([TxIn] -> [TxOut] -> TxBody
TxBody [TxIn
in0, TxIn
in1] forall a. [a]
outs) forall a. [a]
wits
in forall a. HasTypeReps a => a -> Seq TypeRep
typeReps Tx
tx
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Tx)
forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: TxBody)
forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: [TxIn])
forall a. a -> Seq a -> Seq a
<| forall a. HasTypeReps a => a -> Seq TypeRep
typeReps TxIn
in0
forall a. Seq a -> Seq a -> Seq a
>< forall a. HasTypeReps a => a -> Seq TypeRep
typeReps TxIn
in1
forall a. Seq a -> Seq a -> Seq a
>< ( forall a. [a] -> Seq a
Seq.fromList
[ forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: [TxOut])
, forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: [Wit])
]
)
mkCost :: forall a. Typeable a => Map TypeRep Size
mkCost :: forall a. Typeable a => Map TypeRep Int
mkCost = forall k a. k -> a -> Map k a
Map.singleton (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: a)) Int
1
propSumOfSizesTx ::
MonadTest m => Tx -> m ()
propSumOfSizesTx :: forall (m :: * -> *). MonadTest m => Tx -> m ()
propSumOfSizesTx Tx
txw =
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (Map TypeRep Int
txInCosts forall a. Semigroup a => a -> a -> a
<> Map TypeRep Int
txOutCosts forall a. Semigroup a => a -> a -> a
<> Map TypeRep Int
witCosts) Tx
txw
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize Map TypeRep Int
txInCosts (Tx -> TxBody
body Tx
txw)
forall a. Num a => a -> a -> a
+ forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize Map TypeRep Int
txOutCosts (Tx -> TxBody
body Tx
txw)
forall a. Num a => a -> a -> a
+ forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize Map TypeRep Int
witCosts (Tx -> [Wit]
witnesses Tx
txw)
where
txInCosts :: Map TypeRep Size
txInCosts :: Map TypeRep Int
txInCosts = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [forall a. Typeable a => Map TypeRep Int
mkCost @TxIn, forall a. Typeable a => Map TypeRep Int
mkCost @TxId, forall a. Typeable a => Map TypeRep Int
mkCost @Hash]
txOutCosts :: Map TypeRep Size
txOutCosts :: Map TypeRep Int
txOutCosts = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [forall a. Typeable a => Map TypeRep Int
mkCost @TxOut, forall a. Typeable a => Map TypeRep Int
mkCost @Addr, forall a. Typeable a => Map TypeRep Int
mkCost @VKey, forall a. Typeable a => Map TypeRep Int
mkCost @Lovelace]
witCosts :: Map TypeRep Size
witCosts :: Map TypeRep Int
witCosts = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [forall a. Typeable a => Map TypeRep Int
mkCost @Wit, forall a. Typeable a => Map TypeRep Int
mkCost @VKey, forall a. Typeable a => Map TypeRep Int
mkCost @(Sig TxBody)]
propMultipleOfSizes ::
MonadTest m => Tx -> m ()
propMultipleOfSizes :: forall (m :: * -> *). MonadTest m => Tx -> m ()
propMultipleOfSizes Tx
txw =
let body_ :: TxBody
body_ = Tx -> TxBody
body Tx
txw
wits_ :: [Wit]
wits_ = Tx -> [Wit]
witnesses Tx
txw
in do
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @TxIn) Tx
txw forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody -> [TxIn]
inputs TxBody
body_)
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @TxId) Tx
txw forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody -> [TxIn]
inputs TxBody
body_)
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @Hash) Tx
txw forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody -> [TxIn]
inputs TxBody
body_)
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [forall a. Typeable a => Map TypeRep Int
mkCost @TxIn, forall a. Typeable a => Map TypeRep Int
mkCost @TxId, forall a. Typeable a => Map TypeRep Int
mkCost @Hash]) Tx
txw
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @TxIn) Tx
txw
forall a. Num a => a -> a -> a
+ forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @TxId) Tx
txw
forall a. Num a => a -> a -> a
+ forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @Hash) Tx
txw
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @TxOut) Tx
txw forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody -> [TxOut]
outputs TxBody
body_)
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @Addr) Tx
txw forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody -> [TxOut]
outputs TxBody
body_)
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @Lovelace) Tx
txw forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody -> [TxOut]
outputs TxBody
body_)
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [forall a. Typeable a => Map TypeRep Int
mkCost @TxOut, forall a. Typeable a => Map TypeRep Int
mkCost @Addr, forall a. Typeable a => Map TypeRep Int
mkCost @Lovelace]) Tx
txw
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @TxOut) Tx
txw
forall a. Num a => a -> a -> a
+ forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @Addr) Tx
txw
forall a. Num a => a -> a -> a
+ forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @Lovelace) Tx
txw
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @Wit) Tx
txw forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Wit]
wits_
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @(Sig TxBody)) Tx
txw forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Wit]
wits_
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [forall a. Typeable a => Map TypeRep Int
mkCost @Wit, forall a. Typeable a => Map TypeRep Int
mkCost @(Sig TxBody)]) Tx
txw
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @Wit) Tx
txw
forall a. Num a => a -> a -> a
+ forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @(Sig TxBody)) Tx
txw
forall a. HasTypeReps a => Map TypeRep Int -> a -> Int
abstractSize (forall a. Typeable a => Map TypeRep Int
mkCost @VKey) Tx
txw
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody -> [TxOut]
outputs TxBody
body_) forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Wit]
wits_
propTxAbstractSize :: Property
propTxAbstractSize :: Property
propTxAbstractSize =
TestLimit -> Property -> Property
withTests TestLimit
50 forall a b. (a -> b) -> a -> b
$
HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Trace UTXOW
tr <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall s. HasTrace s => BaseEnv s -> Word64 -> Gen (Trace s)
trace @UTXOW () Word64
100)
let txs :: [Tx]
txs = forall s. TraceOrder -> Trace s -> [Signal s]
traceSignals TraceOrder
OldestFirst Trace UTXOW
tr :: [Tx]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). MonadTest m => Tx -> m ()
propSize [Tx]
txs
where
propSize :: Tx -> m ()
propSize Tx
txw = forall (m :: * -> *). MonadTest m => Tx -> m ()
propSumOfSizesTx Tx
txw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). MonadTest m => Tx -> m ()
propMultipleOfSizes Tx
txw
testTxHasTypeReps :: TestTree
testTxHasTypeReps :: TestTree
testTxHasTypeReps =
TestName -> [TestTree] -> TestTree
testGroup
TestName
"Test HasTypeReps instances"
[ TestName -> Assertion -> TestTree
testCase TestName
"AbstractSize - example - TxIn" Assertion
exampleTypeRepsTxIn
, TestName -> Assertion -> TestTree
testCase TestName
"AbstractSize - example - Tx" Assertion
exampleTypeRepsTx
, TestName -> Property -> TestTree
testProperty TestName
"AbstractSize and HasTypeReps - Tx*" Property
propTxAbstractSize
]