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

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

import Cardano.Chain.UTxO (
  fromCompactTxId,
  fromCompactTxIn,
  fromCompactTxOut,
  toCompactTxId,
  toCompactTxIn,
  toCompactTxOut,
 )
import Cardano.HeapWords (HeapWords (..))
import Cardano.Prelude
import Hedgehog (MonadTest, assert, forAll, property, tripping)
import Test.Cardano.Chain.UTxO.Gen (genTxId, genTxIn, genTxOut)
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS, withTestsTS)

--------------------------------------------------------------------------------
-- Compact TxIn
--------------------------------------------------------------------------------

ts_roundTripCompactTxIn :: TSProperty
ts_roundTripCompactTxIn :: TSProperty
ts_roundTripCompactTxIn =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen TxIn
genTxIn (forall (m :: * -> *) a b.
(HasCallStack, MonadTest m, Show a, Show b, Eq a) =>
(a -> b) -> (b -> a) -> a -> m ()
trippingCompact TxIn -> CompactTxIn
toCompactTxIn CompactTxIn -> TxIn
fromCompactTxIn)

ts_prop_heapWordsSavingsCompactTxIn :: TSProperty
ts_prop_heapWordsSavingsCompactTxIn :: TSProperty
ts_prop_heapWordsSavingsCompactTxIn = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000
  forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
property
  forall a b. (a -> b) -> a -> b
$ do
    TxIn
txIn <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen TxIn
genTxIn
    let compactTxIn :: CompactTxIn
compactTxIn = TxIn -> CompactTxIn
toCompactTxIn TxIn
txIn
    forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert forall a b. (a -> b) -> a -> b
$ forall a. HeapWords a => a -> Int
heapWords CompactTxIn
compactTxIn forall a. Ord a => a -> a -> Bool
< forall a. HeapWords a => a -> Int
heapWords TxIn
txIn

--------------------------------------------------------------------------------
-- Compact TxId
--------------------------------------------------------------------------------

ts_roundTripCompactTxId :: TSProperty
ts_roundTripCompactTxId :: TSProperty
ts_roundTripCompactTxId =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen TxId
genTxId (forall (m :: * -> *) a b.
(HasCallStack, MonadTest m, Show a, Show b, Eq a) =>
(a -> b) -> (b -> a) -> a -> m ()
trippingCompact TxId -> CompactTxId
toCompactTxId CompactTxId -> TxId
fromCompactTxId)

ts_prop_heapWordsSavingsCompactTxId :: TSProperty
ts_prop_heapWordsSavingsCompactTxId :: TSProperty
ts_prop_heapWordsSavingsCompactTxId = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000
  forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
property
  forall a b. (a -> b) -> a -> b
$ do
    TxId
txId <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen TxId
genTxId
    let compactTxId :: CompactTxId
compactTxId = TxId -> CompactTxId
toCompactTxId TxId
txId
    forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert forall a b. (a -> b) -> a -> b
$ forall a. HeapWords a => a -> Int
heapWords CompactTxId
compactTxId forall a. Ord a => a -> a -> Bool
< forall a. HeapWords a => a -> Int
heapWords TxId
txId

--------------------------------------------------------------------------------
-- Compact TxOut
--------------------------------------------------------------------------------

ts_roundTripCompactTxOut :: TSProperty
ts_roundTripCompactTxOut :: TSProperty
ts_roundTripCompactTxOut =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen TxOut
genTxOut (forall (m :: * -> *) a b.
(HasCallStack, MonadTest m, Show a, Show b, Eq a) =>
(a -> b) -> (b -> a) -> a -> m ()
trippingCompact TxOut -> CompactTxOut
toCompactTxOut CompactTxOut -> TxOut
fromCompactTxOut)

ts_prop_heapWordsSavingsCompactTxOut :: TSProperty
ts_prop_heapWordsSavingsCompactTxOut :: TSProperty
ts_prop_heapWordsSavingsCompactTxOut = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000
  forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
property
  forall a b. (a -> b) -> a -> b
$ do
    TxOut
txOut <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen TxOut
genTxOut
    let compactTxOut :: CompactTxOut
compactTxOut = TxOut -> CompactTxOut
toCompactTxOut TxOut
txOut
    forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert forall a b. (a -> b) -> a -> b
$ forall a. HeapWords a => a -> Int
heapWords CompactTxOut
compactTxOut forall a. Ord a => a -> a -> Bool
< forall a. HeapWords a => a -> Int
heapWords TxOut
txOut

-------------------------------------------------------------------------------
-- Tripping util
-------------------------------------------------------------------------------

trippingCompact ::
  (HasCallStack, MonadTest m, Show a, Show b, Eq a) =>
  (a -> b) ->
  (b -> a) ->
  a ->
  m ()
trippingCompact :: forall (m :: * -> *) a b.
(HasCallStack, MonadTest m, Show a, Show b, Eq a) =>
(a -> b) -> (b -> a) -> a -> m ()
trippingCompact a -> b
toCompact b -> a
fromCompact a
x =
  forall (m :: * -> *) (f :: * -> *) b a.
(MonadTest m, Applicative f, Show b, Show (f a), Eq (f a),
 HasCallStack) =>
a -> (a -> b) -> (b -> f a) -> m ()
tripping a
x a -> b
toCompact (forall a. a -> Identity a
Identity forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> a
fromCompact)

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

tests :: TSGroup
tests :: TSGroup
tests = [TSGroup] -> TSGroup
concatTSGroups [$$discoverPropArg, $$discoverRoundTripArg]