{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Byron.Spec.Ledger.UTxO.Properties where

import Byron.Spec.Ledger.Core (Lovelace, dom, unLovelace, (∩), (∪), (⋪), (◁))
import Byron.Spec.Ledger.STS.UTXO (UTxOState (UTxOState), pps, reserves, utxo)
import Byron.Spec.Ledger.STS.UTXOW (UTXOW)
import Byron.Spec.Ledger.UTxO (
  Tx (..),
  TxBody (TxBody),
  TxIn (TxIn),
  TxOut (TxOut),
  UTxO (UTxO),
  balance,
  body,
  inputs,
  outputs,
  pcMinFee,
  txins,
  txouts,
 )
import Control.Arrow (second, (***))
import Control.Monad (when)
import Data.Foldable as F (foldl', traverse_)
import qualified Data.Map.Strict as Map
import Data.Set (Set, empty, fromList, union)
import Hedgehog (
  MonadTest,
  Property,
  classify,
  cover,
  forAll,
  property,
  success,
  withTests,
  (===),
 )
import Lens.Micro ((&), (^.), _2)
import Lens.Micro.Extras (view)
import Test.Control.State.Transition.Generator (classifyTraceLength, trace, traceOfLength)
import Test.Control.State.Transition.Trace (
  Trace,
  TraceOrder (OldestFirst),
  firstAndLastState,
  preStatesAndSignals,
  traceEnv,
  traceLength,
  traceSignals,
  _traceInitState,
 )

--------------------------------------------------------------------------------
-- UTxO Properties
--------------------------------------------------------------------------------

-- | Check that the money is constant in the system.
moneyIsConstant :: Property
moneyIsConstant :: Property
moneyIsConstant = TestLimit -> Property -> Property
withTests TestLimit
300 (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  (UTxOState
st0, UTxOState
st) <- Trace UTXOW -> (UTxOState, UTxOState)
Trace UTXOW -> (State UTXOW, State UTXOW)
forall s. Trace s -> (State s, State s)
firstAndLastState (Trace UTXOW -> (UTxOState, UTxOState))
-> PropertyT IO (Trace UTXOW)
-> PropertyT IO (UTxOState, UTxOState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Trace UTXOW) -> PropertyT IO (Trace UTXOW)
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)
  UTxOState -> Lovelace
reserves UTxOState
st0 Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
+ UTxO -> Lovelace
balance (UTxOState -> UTxO
utxo UTxOState
st0) Lovelace -> Lovelace -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== UTxOState -> Lovelace
reserves UTxOState
st Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
+ UTxO -> Lovelace
balance (UTxOState -> UTxO
utxo UTxOState
st)

-- | Check that there is no double spending
noDoubleSpending :: Property
noDoubleSpending :: Property
noDoubleSpending = TestLimit -> Property -> Property
withTests TestLimit
300 (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  Trace UTXOW
t <- Gen (Trace UTXOW) -> PropertyT IO (Trace UTXOW)
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 UTxOState {utxo :: UTxOState -> UTxO
utxo = UTxO
utxo0} = Trace UTXOW -> State UTXOW
forall s. Trace s -> State s
_traceInitState Trace UTXOW
t
      txs :: [TxBody]
txs = Tx -> TxBody
body (Tx -> TxBody) -> [Tx] -> [TxBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TraceOrder -> Trace UTXOW -> [Signal UTXOW]
forall s. TraceOrder -> Trace s -> [Signal s]
traceSignals TraceOrder
OldestFirst Trace UTXOW
t
  Bool -> PropertyT IO () -> PropertyT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((TxBody -> Bool) -> [TxBody] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\TxBody
ti -> UTxO -> Set (Domain UTxO)
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (TxBody -> UTxO
txouts TxBody
ti) Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
∩ UTxO -> Set (Domain UTxO)
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom UTxO
utxo0 Set TxIn -> Set TxIn -> Bool
forall a. Eq a => a -> a -> Bool
== Set TxIn
forall a. Set a
empty) [TxBody]
txs) (PropertyT IO () -> PropertyT IO ())
-> PropertyT IO () -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$
    ((TxBody, Int) -> PropertyT IO ())
-> [(TxBody, Int)] -> PropertyT IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ([TxBody] -> (TxBody, Int) -> PropertyT IO ()
forall (m :: * -> *).
MonadTest m =>
[TxBody] -> (TxBody, Int) -> m ()
noCommonInputsTxs [TxBody]
txs) ([TxBody] -> [Int] -> [(TxBody, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxBody]
txs [Int
0 ..])
  where
    noCommonInputsTxs :: MonadTest m => [TxBody] -> (TxBody, Int) -> m ()
    noCommonInputsTxs :: forall (m :: * -> *).
MonadTest m =>
[TxBody] -> (TxBody, Int) -> m ()
noCommonInputsTxs [TxBody]
txs (TxBody
tx, Int
i) =
      (TxBody -> m ()) -> [TxBody] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\TxBody
txj -> TxBody -> Set TxIn
txins' TxBody
txj Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
∩ TxBody -> Set TxIn
txins' TxBody
tx Set TxIn -> Set TxIn -> m ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Set TxIn
forall a. Set a
empty) (Int -> [TxBody] -> [TxBody]
forall a. Int -> [a] -> [a]
take Int
i [TxBody]
txs)

    txins' :: TxBody -> Set TxIn
    txins' :: TxBody -> Set TxIn
txins' = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
fromList ([TxIn] -> Set TxIn) -> (TxBody -> [TxIn]) -> TxBody -> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody -> [TxIn]
txins

-- | Check that UTxO is outputs minus inputs
utxoDiff :: Property
utxoDiff :: Property
utxoDiff = TestLimit -> Property -> Property
withTests TestLimit
300 (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  Trace UTXOW
t <- Gen (Trace UTXOW) -> PropertyT IO (Trace UTXOW)
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 (UTxO
utxo0, UTxO
utxoSt) = (UTxOState -> UTxO
utxo (UTxOState -> UTxO)
-> (UTxOState -> UTxO) -> (UTxOState, UTxOState) -> (UTxO, UTxO)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** UTxOState -> UTxO
utxo) ((UTxOState, UTxOState) -> (UTxO, UTxO))
-> (Trace UTXOW -> (UTxOState, UTxOState))
-> Trace UTXOW
-> (UTxO, UTxO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace UTXOW -> (UTxOState, UTxOState)
Trace UTXOW -> (State UTXOW, State UTXOW)
forall s. Trace s -> (State s, State s)
firstAndLastState (Trace UTXOW -> (UTxO, UTxO)) -> Trace UTXOW -> (UTxO, UTxO)
forall a b. (a -> b) -> a -> b
$ Trace UTXOW
t
      txs :: [TxBody]
txs = Tx -> TxBody
body (Tx -> TxBody) -> [Tx] -> [TxBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TraceOrder -> Trace UTXOW -> [Signal UTXOW]
forall s. TraceOrder -> Trace s -> [Signal s]
traceSignals TraceOrder
OldestFirst Trace UTXOW
t
  Bool -> PropertyT IO () -> PropertyT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((TxBody -> Bool) -> [TxBody] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\TxBody
ti -> UTxO -> Set (Domain UTxO)
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (TxBody -> UTxO
txouts TxBody
ti) Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
∩ UTxO -> Set (Domain UTxO)
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom UTxO
utxo0 Set TxIn -> Set TxIn -> Bool
forall a. Eq a => a -> a -> Bool
== Set TxIn
forall a. Set a
empty) [TxBody]
txs) (PropertyT IO () -> PropertyT IO ())
-> PropertyT IO () -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$
    (Set TxIn -> TxBody -> Set TxIn)
-> Set TxIn -> [TxBody] -> Set TxIn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Set TxIn -> TxBody -> Set TxIn
union' Set TxIn
forall a. Set a
empty [TxBody]
txs Set (Domain UTxO) -> UTxO -> UTxO
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain UTxO), Foldable f) =>
f (Domain UTxO) -> UTxO -> UTxO
⋪ (UTxO
utxo0 UTxO -> UTxO -> UTxO
forall m.
(Relation m, Ord (Domain m), Ord (Range m)) =>
m -> m -> m
∪ [TxBody] -> UTxO
allTxOuts [TxBody]
txs) UTxO -> UTxO -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== UTxO
utxoSt
  where
    union' :: Set TxIn -> TxBody -> Set TxIn
    union' :: Set TxIn -> TxBody -> Set TxIn
union' Set TxIn
s TxBody
tx = Set TxIn
s Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`union` [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
fromList (TxBody -> [TxIn]
txins TxBody
tx)

    allTxOuts :: [TxBody] -> UTxO
    allTxOuts :: [TxBody] -> UTxO
allTxOuts [TxBody]
txs = (UTxO -> UTxO -> UTxO) -> UTxO -> [UTxO] -> UTxO
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' UTxO -> UTxO -> UTxO
forall m.
(Relation m, Ord (Domain m), Ord (Range m)) =>
m -> m -> m
(∪) (Map TxIn TxOut -> UTxO
UTxO Map TxIn TxOut
forall k a. Map k a
Map.empty) ((TxBody -> UTxO) -> [TxBody] -> [UTxO]
forall a b. (a -> b) -> [a] -> [b]
map TxBody -> UTxO
txouts [TxBody]
txs)

utxoAndTxoutsMustBeDisjoint :: Property
utxoAndTxoutsMustBeDisjoint :: Property
utxoAndTxoutsMustBeDisjoint = TestLimit -> Property -> Property
withTests TestLimit
300 (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  Trace UTXOW
t <- Gen (Trace UTXOW) -> PropertyT IO (Trace UTXOW)
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)
  ((UTxOState, TxBody) -> PropertyT IO ())
-> [(UTxOState, TxBody)] -> PropertyT IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (UTxOState, TxBody) -> PropertyT IO ()
forall {m :: * -> *}. MonadTest m => (UTxOState, TxBody) -> m ()
utxoAndTxoutsAreDisjoint ([(UTxOState, TxBody)] -> PropertyT IO ())
-> [(UTxOState, TxBody)] -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$
    ((UTxOState, Tx) -> (UTxOState, TxBody))
-> [(UTxOState, Tx)] -> [(UTxOState, TxBody)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tx -> TxBody) -> (UTxOState, Tx) -> (UTxOState, TxBody)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Tx -> TxBody
body) ([(UTxOState, Tx)] -> [(UTxOState, TxBody)])
-> [(UTxOState, Tx)] -> [(UTxOState, TxBody)]
forall a b. (a -> b) -> a -> b
$
      TraceOrder -> Trace UTXOW -> [(State UTXOW, Signal UTXOW)]
forall s. TraceOrder -> Trace s -> [(State s, Signal s)]
preStatesAndSignals TraceOrder
OldestFirst Trace UTXOW
t
  where
    utxoAndTxoutsAreDisjoint :: (UTxOState, TxBody) -> m ()
utxoAndTxoutsAreDisjoint (UTxOState {UTxO
utxo :: UTxOState -> UTxO
utxo :: UTxO
utxo}, TxBody
tx) =
      UTxO -> Set (Domain UTxO)
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom UTxO
utxo Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
∩ UTxO -> Set (Domain UTxO)
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (TxBody -> UTxO
txouts TxBody
tx) Set TxIn -> Set TxIn -> m ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Set TxIn
forall a. Monoid a => a
mempty

--------------------------------------------------------------------------------
-- Coverage guarantees for UTxO traces
--------------------------------------------------------------------------------

relevantCasesAreCovered :: Property
relevantCasesAreCovered :: Property
relevantCasesAreCovered = TestLimit -> Property -> Property
withTests TestLimit
400 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
  HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    let tl :: Word64
tl = Word64
300
    Trace UTXOW
tr <- Gen (Trace UTXOW) -> PropertyT IO (Trace UTXOW)
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall s. HasTrace s => BaseEnv s -> Word64 -> Gen (Trace s)
traceOfLength @UTXOW () Word64
tl)
    let n :: Integer
        n :: Integer
n = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Trace UTXOW -> Int
forall s. Trace s -> Int
traceLength Trace UTXOW
tr

    Bool -> PropertyT IO () -> PropertyT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (PropertyT IO () -> PropertyT IO ())
-> PropertyT IO () -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ do
      let ss :: [(State UTXOW, Signal UTXOW)]
ss = TraceOrder -> Trace UTXOW -> [(State UTXOW, Signal UTXOW)]
forall s. TraceOrder -> Trace s -> [(State s, Signal s)]
preStatesAndSignals TraceOrder
OldestFirst Trace UTXOW
tr
          txs :: [TxBody]
txs = (Tx -> TxBody
body (Tx -> TxBody)
-> ((UTxOState, Tx) -> Tx) -> (UTxOState, Tx) -> TxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Tx (UTxOState, Tx) Tx -> (UTxOState, Tx) -> Tx
forall a s. Getting a s a -> s -> a
view Getting Tx (UTxOState, Tx) Tx
forall s t a b. Field2 s t a b => Lens s t a b
Lens (UTxOState, Tx) (UTxOState, Tx) Tx Tx
_2) ((UTxOState, Tx) -> TxBody) -> [(UTxOState, Tx)] -> [TxBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTxOState, Tx)]
[(State UTXOW, Signal UTXOW)]
ss
          (Double
avgInputs, Double
avgOutputs) = [TxBody] -> (Double, Double)
avgInputsOutputs [TxBody]
txs

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
20 LabelName
"all txs have zero fee surplus" (Trace UTXOW -> Integer -> Int
avgFeeSurplus Trace UTXOW
tr Integer
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
20 LabelName
"avg. tx fee surplus (0,10]" (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Trace UTXOW -> Integer -> Int
avgFeeSurplus Trace UTXOW
tr Integer
n Bool -> Bool -> Bool
&& Trace UTXOW -> Integer -> Int
avgFeeSurplus Trace UTXOW
tr Integer
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10)
      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
20 LabelName
"avg. tx fee surplus (10,30]" (Int
10 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Trace UTXOW -> Integer -> Int
avgFeeSurplus Trace UTXOW
tr Integer
n Bool -> Bool -> Bool
&& Trace UTXOW -> Integer -> Int
avgFeeSurplus Trace UTXOW
tr Integer
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
30)
      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
1 LabelName
"avg. tx fee surplus (30,...)" (Int
30 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Trace UTXOW -> Integer -> Int
avgFeeSurplus Trace UTXOW
tr Integer
n)

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
20 LabelName
"avg. nr. of tx inputs (1,5]" (Double
1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgInputs Bool -> Bool -> Bool
&& Double
avgInputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
5)
      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
20 LabelName
"avg. nr. of tx inputs (5,10]" (Double
5 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
avgInputs Bool -> Bool -> Bool
&& Double
avgInputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
10)

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
20 LabelName
"avg. nr. of tx outputs (1,5]" (Double
1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgOutputs Bool -> Bool -> Bool
&& Double
avgOutputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
5)
      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
20 LabelName
"avg. nr. of tx outputs (5,10]" (Double
5 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
avgOutputs Bool -> Bool -> Bool
&& Double
avgOutputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
10)

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
80 LabelName
"starting UTxO has no future inputs" ((Set TxIn -> Bool) -> [Set TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Set TxIn -> Set TxIn -> Bool
forall a. Eq a => a -> a -> Bool
== Set TxIn
forall a. Set a
empty) (Trace UTXOW -> [Set TxIn]
futureInputs Trace UTXOW
tr))
  where
    avgFeeSurplus :: Trace UTXOW -> Integer -> Int
    avgFeeSurplus :: Trace UTXOW -> Integer -> Int
avgFeeSurplus Trace UTXOW
tr Integer
n =
      TraceOrder -> Trace UTXOW -> [(State UTXOW, Signal UTXOW)]
forall s. TraceOrder -> Trace s -> [(State s, Signal s)]
preStatesAndSignals TraceOrder
OldestFirst Trace UTXOW
tr
        [(UTxOState, Tx)] -> ([(UTxOState, Tx)] -> [Integer]) -> [Integer]
forall a b. a -> (a -> b) -> b
& ((UTxOState, Tx) -> Integer) -> [(UTxOState, Tx)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ((Tx -> Lovelace) -> (UTxOState, Tx) -> Integer
txFeeSurplus (PParams -> Tx -> Lovelace
pcMinFee PParams
pps_))
        [Integer] -> ([Integer] -> Integer) -> Integer
forall a b. a -> (a -> b) -> b
& [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
        Integer -> (Integer -> Integer) -> Integer
forall a b. a -> (a -> b) -> b
& (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
n)
        Integer -> (Integer -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      where
        pps_ :: PParams
pps_ = UTxOEnv -> PParams
pps (Trace UTXOW
tr Trace UTXOW -> Getting UTxOEnv (Trace UTXOW) UTxOEnv -> UTxOEnv
forall s a. s -> Getting a s a -> a
^. Getting UTxOEnv (Trace UTXOW) UTxOEnv
(Environment UTXOW -> Const UTxOEnv (Environment UTXOW))
-> Trace UTXOW -> Const UTxOEnv (Trace UTXOW)
forall s (f :: * -> *).
Functor f =>
(Environment s -> f (Environment s)) -> Trace s -> f (Trace s)
traceEnv)
    txFeeSurplus :: (Tx -> Lovelace) -> (UTxOState, Tx) -> Integer
    txFeeSurplus :: (Tx -> Lovelace) -> (UTxOState, Tx) -> Integer
txFeeSurplus Tx -> Lovelace
txMinFee (UTxOState
st, Tx
txw) =
      Integer
fee Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
minFee
      where
        tx_ :: TxBody
tx_ = Tx -> TxBody
body Tx
txw
        utxo_ :: UTxO
utxo_ = UTxOState -> UTxO
utxo UTxOState
st
        fee :: Integer
fee = Lovelace -> Integer
unLovelace (Lovelace -> Integer) -> Lovelace -> Integer
forall a b. (a -> b) -> a -> b
$ UTxO -> Lovelace
balance (TxBody -> [TxIn]
txins TxBody
tx_ [Domain UTxO] -> UTxO -> UTxO
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain UTxO), Foldable f) =>
f (Domain UTxO) -> UTxO -> UTxO
◁ UTxO
utxo_) Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
- UTxO -> Lovelace
balance (TxBody -> UTxO
txouts TxBody
tx_)
        minFee :: Integer
minFee = Lovelace -> Integer
unLovelace (Lovelace -> Integer) -> Lovelace -> Integer
forall a b. (a -> b) -> a -> b
$ Tx -> Lovelace
txMinFee Tx
txw
    futureInputs :: Trace UTXOW -> [Set TxIn]
    futureInputs :: Trace UTXOW -> [Set TxIn]
futureInputs Trace UTXOW
tr =
      let UTxOState {utxo :: UTxOState -> UTxO
utxo = UTxO
utxo0} = Trace UTXOW -> State UTXOW
forall s. Trace s -> State s
_traceInitState Trace UTXOW
tr
          txs :: [TxBody]
txs = Tx -> TxBody
body (Tx -> TxBody) -> [Tx] -> [TxBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TraceOrder -> Trace UTXOW -> [Signal UTXOW]
forall s. TraceOrder -> Trace s -> [Signal s]
traceSignals TraceOrder
OldestFirst Trace UTXOW
tr
       in (\TxBody
ti -> UTxO -> Set (Domain UTxO)
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (TxBody -> UTxO
txouts TxBody
ti) Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
∩ UTxO -> Set (Domain UTxO)
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom UTxO
utxo0) (TxBody -> Set TxIn) -> [TxBody] -> [Set TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxBody]
txs

-- | Returns the average number of inputs and outputs for a list of transactions.
avgInputsOutputs :: [TxBody] -> (Double, Double)
avgInputsOutputs :: [TxBody] -> (Double, Double)
avgInputsOutputs [TxBody]
txs =
  case [TxBody] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxBody]
txs of
    Int
0 -> (Double
0, Double
0)
    Int
n ->
      ( Double
nrInputs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      , Double
nrOutputs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      )
  where
    nrInputs :: Double
nrInputs = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxIn] -> Int) -> (TxBody -> [TxIn]) -> TxBody -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody -> [TxIn]
inputs (TxBody -> Int) -> [TxBody] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxBody]
txs)
    nrOutputs :: Double
nrOutputs = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxOut] -> Int) -> (TxBody -> [TxOut]) -> TxBody -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody -> [TxOut]
outputs (TxBody -> Int) -> [TxBody] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxBody]
txs)

--------------------------------------------------------------------------------
-- Classified Traces (not included in CI test runs, but useful for development)
--------------------------------------------------------------------------------

-- To test the performance of the integrated shrinker for UTxO traces one could
-- replace the return statement of the 'UTXO' @transitionRule@ by:
--
-- >>> let xs =
-- >>>       if 2 < length (txins tx)
-- >>>       then drop 1 (txins tx)
-- >>>       else txins tx
-- >>> return $ UTxOState { utxo     = (xs ⋪ utxo) ∪ txouts tx
-- >>>                    , reserves = reserves + fee
-- >>>                    }
--
-- This should give a minimal counterexample of a trace with a signal
-- containing exactly 3 inputs, and only one output.
tracesAreClassified :: Property
tracesAreClassified :: Property
tracesAreClassified = TestLimit -> Property -> Property
withTests TestLimit
200 (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  let (Word64
tl, Word64
step) = (Word64
100, Word64
10)
  Trace UTXOW
tr <- Gen (Trace UTXOW) -> PropertyT IO (Trace UTXOW)
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
tl)
  Trace UTXOW -> Word64 -> Word64 -> PropertyT IO ()
forall s. Trace s -> Word64 -> Word64 -> PropertyT IO ()
classifyTraceLength Trace UTXOW
tr Word64
tl Word64
step

  let pparams :: PParams
pparams = UTxOEnv -> PParams
pps (Trace UTXOW
tr Trace UTXOW -> Getting UTxOEnv (Trace UTXOW) UTxOEnv -> UTxOEnv
forall s a. s -> Getting a s a -> a
^. Getting UTxOEnv (Trace UTXOW) UTxOEnv
(Environment UTXOW -> Const UTxOEnv (Environment UTXOW))
-> Trace UTXOW -> Const UTxOEnv (Trace UTXOW)
forall s (f :: * -> *).
Functor f =>
(Environment s -> f (Environment s)) -> Trace s -> f (Trace s)
traceEnv)
      -- Transaction with one input, one output and no witnesses
      unitTx :: Tx
unitTx = TxBody -> [Wit] -> Tx
Tx ([TxIn] -> [TxOut] -> TxBody
TxBody [TxId -> Natural -> TxIn
TxIn TxId
forall a. HasCallStack => a
undefined Natural
0] [Addr -> Lovelace -> TxOut
TxOut Addr
forall a. HasCallStack => a
undefined Lovelace
100]) []
      unitTxFee :: Lovelace
unitTxFee = PParams -> Tx -> Lovelace
pcMinFee PParams
pparams Tx
unitTx
  LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"Unit transaction cost == 0" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Lovelace
unitTxFee Lovelace -> Lovelace -> Bool
forall a. Eq a => a -> a -> Bool
== Lovelace
0
  LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"Unit transaction cost == 1" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Lovelace
unitTxFee Lovelace -> Lovelace -> Bool
forall a. Eq a => a -> a -> Bool
== Lovelace
1
  LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"Unit transaction cost [2, 5)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Lovelace
2 Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
<= Lovelace
unitTxFee Bool -> Bool -> Bool
&& Lovelace
unitTxFee Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
< Lovelace
5
  LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"Unit transaction cost [5, 10)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Lovelace
5 Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
<= Lovelace
unitTxFee Bool -> Bool -> Bool
&& Lovelace
unitTxFee Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
< Lovelace
10
  LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"Unit transaction cost [10, 25)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Lovelace
10 Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
<= Lovelace
unitTxFee Bool -> Bool -> Bool
&& Lovelace
unitTxFee Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
< Lovelace
25
  LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"Unit transaction cost [25, 100)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Lovelace
25 Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
<= Lovelace
unitTxFee Bool -> Bool -> Bool
&& Lovelace
unitTxFee Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
< Lovelace
100
  LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"Unit transaction cost >= 100" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Lovelace
100 Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
<= Lovelace
unitTxFee

  -- Classify the average number of inputs and outputs. Note that the intervals
  -- were arbitrarily determined, since in order to have a good partition of
  -- the interval [0, maximum possible number of inputs/outputs] we'd need to
  -- know how many addresses are being used in the trace generation.
  let actualTl :: Int
actualTl = Trace UTXOW -> Int
forall s. Trace s -> Int
traceLength Trace UTXOW
tr
  Bool -> PropertyT IO () -> PropertyT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
actualTl) (PropertyT IO () -> PropertyT IO ())
-> PropertyT IO () -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ do
    let txs :: [TxBody]
txs = Tx -> TxBody
body (Tx -> TxBody) -> [Tx] -> [TxBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TraceOrder -> Trace UTXOW -> [Signal UTXOW]
forall s. TraceOrder -> Trace s -> [Signal s]
traceSignals TraceOrder
OldestFirst Trace UTXOW
tr
        (Double
avgInputs, Double
avgOutputs) = [TxBody] -> (Double, Double)
avgInputsOutputs [TxBody]
txs

    -- Classify the average number of inputs
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. inputs == 0" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ (Double
0 :: Double) Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
avgInputs
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. inputs == 1" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
avgInputs
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. inputs [2, 5)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgInputs Bool -> Bool -> Bool
&& Double
avgInputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
5
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. inputs [5, 10)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
5 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgInputs Bool -> Bool -> Bool
&& Double
avgInputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. inputs [10, 25)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
10 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgInputs Bool -> Bool -> Bool
&& Double
avgInputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
25
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. inputs [25, 100)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
25 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgInputs Bool -> Bool -> Bool
&& Double
avgInputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
100
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
">= 100" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
100 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgInputs
    -- Classify the average number of outputs
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. outputs == 0" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ (Double
0 :: Double) Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
avgOutputs
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. outputs == 1" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
avgOutputs
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. outputs [2, 5)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgOutputs Bool -> Bool -> Bool
&& Double
avgOutputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
5
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. outputs [5, 10)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
5 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgOutputs Bool -> Bool -> Bool
&& Double
avgOutputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. outputs [10, 25)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
10 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgOutputs Bool -> Bool -> Bool
&& Double
avgOutputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
25
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
"avg nr. outputs [25, 100)" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
25 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgOutputs Bool -> Bool -> Bool
&& Double
avgOutputs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
100
    LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
">= 100" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Double
100 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
avgOutputs
  PropertyT IO ()
forall (m :: * -> *). MonadTest m => m ()
success