module Hydra.Ledger.SimpleSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Data.Foldable (maximum)
import Data.Set qualified as Set
import Hydra.Chain.ChainState (ChainSlot (ChainSlot))
import Hydra.Ledger (applyTransactions)
import Hydra.Ledger.Simple
import Hydra.Tx.IsTx (IsTx (..))
import Test.QuickCheck (Property, choose, forAllShrink, getSize, shrinkList, sublistOf)

spec :: Spec
spec :: Spec
spec =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"validates only correctly built transactions" Property
prop_validateCorrectTransactions

prop_validateCorrectTransactions :: Property
prop_validateCorrectTransactions :: Property
prop_validateCorrectTransactions =
  Gen [SimpleTx]
-> ([SimpleTx] -> [[SimpleTx]]) -> ([SimpleTx] -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink (UTxOType SimpleTx -> Gen [SimpleTx]
genSequenceOfValidTransactions Set SimpleTxOut
UTxOType SimpleTx
forall a. Monoid a => a
mempty) [SimpleTx] -> [[SimpleTx]]
shrinkSequence (([SimpleTx] -> Bool) -> Property)
-> ([SimpleTx] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \[SimpleTx]
txs ->
    Either (SimpleTx, ValidationError) (Set SimpleTxOut) -> Bool
forall a b. Either a b -> Bool
isRight (Ledger SimpleTx
-> ChainSlot
-> UTxOType SimpleTx
-> [SimpleTx]
-> Either (SimpleTx, ValidationError) (UTxOType SimpleTx)
forall tx.
Ledger tx
-> ChainSlot
-> UTxOType tx
-> [tx]
-> Either (tx, ValidationError) (UTxOType tx)
applyTransactions Ledger SimpleTx
simpleLedger (Natural -> ChainSlot
ChainSlot Natural
0) Set SimpleTxOut
UTxOType SimpleTx
forall a. Monoid a => a
mempty [SimpleTx]
txs)

shrinkSequence :: [SimpleTx] -> [[SimpleTx]]
shrinkSequence :: [SimpleTx] -> [[SimpleTx]]
shrinkSequence = (SimpleTx -> [SimpleTx]) -> [SimpleTx] -> [[SimpleTx]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList ([SimpleTx] -> SimpleTx -> [SimpleTx]
forall a b. a -> b -> a
const [])

genSequenceOfValidTransactions :: UTxOType SimpleTx -> Gen [SimpleTx]
genSequenceOfValidTransactions :: UTxOType SimpleTx -> Gen [SimpleTx]
genSequenceOfValidTransactions UTxOType SimpleTx
initialUTxO = do
  Integer
n <- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Gen Int -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
getSize
  let maxId :: Integer
maxId = if Set SimpleTxOut -> Bool
forall a. Set a -> Bool
Set.null Set SimpleTxOut
UTxOType SimpleTx
initialUTxO then Integer
0 else SimpleTxOut -> Integer
unSimpleTxOut (Set SimpleTxOut -> SimpleTxOut
forall a. Ord a => Set a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum Set SimpleTxOut
UTxOType SimpleTx
initialUTxO)
  Integer
numTxs <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
n)
  ((Integer, Set SimpleTxOut, [SimpleTx])
 -> Integer -> Gen (Integer, Set SimpleTxOut, [SimpleTx]))
-> (Integer, Set SimpleTxOut, [SimpleTx])
-> [Integer]
-> Gen (Integer, Set SimpleTxOut, [SimpleTx])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (Integer, Set SimpleTxOut, [SimpleTx])
-> Integer -> Gen (Integer, Set SimpleTxOut, [SimpleTx])
(TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
-> TxIdType SimpleTx
-> Gen (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
newTx (Integer
maxId, Set SimpleTxOut
UTxOType SimpleTx
initialUTxO, [SimpleTx]
forall a. Monoid a => a
mempty) [Integer
1 .. Integer
numTxs] Gen (Integer, Set SimpleTxOut, [SimpleTx])
-> ((Integer, Set SimpleTxOut, [SimpleTx]) -> Gen [SimpleTx])
-> Gen [SimpleTx]
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Integer
_, Set SimpleTxOut
_, [SimpleTx]
txs) -> [SimpleTx] -> Gen [SimpleTx]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SimpleTx] -> [SimpleTx]
forall a. [a] -> [a]
reverse [SimpleTx]
txs)
 where
  newTx ::
    (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx]) ->
    TxIdType SimpleTx ->
    Gen (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
  newTx :: (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
-> TxIdType SimpleTx
-> Gen (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
newTx (TxIdType SimpleTx
maxId, UTxOType SimpleTx
utxo, [SimpleTx]
txs) TxIdType SimpleTx
txid = do
    (Integer
newMax, Set SimpleTxOut
ins, Set SimpleTxOut
outs) <- Integer
-> Set SimpleTxOut
-> Gen (Integer, Set SimpleTxOut, Set SimpleTxOut)
genInputsAndOutputs Integer
TxIdType SimpleTx
maxId Set SimpleTxOut
UTxOType SimpleTx
utxo
    (Integer, Set SimpleTxOut, [SimpleTx])
-> Gen (Integer, Set SimpleTxOut, [SimpleTx])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
newMax, (Set SimpleTxOut
UTxOType SimpleTx
utxo Set SimpleTxOut -> Set SimpleTxOut -> Set SimpleTxOut
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set SimpleTxOut
ins) Set SimpleTxOut -> Set SimpleTxOut -> Set SimpleTxOut
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set SimpleTxOut
outs, Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
TxIdType SimpleTx
txid Set SimpleTxOut
UTxOType SimpleTx
ins Set SimpleTxOut
UTxOType SimpleTx
outs SimpleTx -> [SimpleTx] -> [SimpleTx]
forall a. a -> [a] -> [a]
: [SimpleTx]
txs)

  genInputsAndOutputs :: Integer -> Set SimpleTxOut -> Gen (Integer, Set SimpleTxOut, Set SimpleTxOut)
  genInputsAndOutputs :: Integer
-> Set SimpleTxOut
-> Gen (Integer, Set SimpleTxOut, Set SimpleTxOut)
genInputsAndOutputs Integer
maxId Set SimpleTxOut
utxo = do
    [SimpleTxOut]
ins <- [SimpleTxOut] -> Gen [SimpleTxOut]
forall a. [a] -> Gen [a]
sublistOf (Set SimpleTxOut -> [SimpleTxOut]
forall a. Set a -> [a]
Set.toList Set SimpleTxOut
utxo)
    Integer
numOuts <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
10)
    let outs :: [Integer]
outs = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
maxId) [Integer
1 .. Integer
numOuts]
    (Integer, Set SimpleTxOut, Set SimpleTxOut)
-> Gen (Integer, Set SimpleTxOut, Set SimpleTxOut)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Integer]
outs, [SimpleTxOut] -> Set SimpleTxOut
forall a. Ord a => [a] -> Set a
Set.fromList [SimpleTxOut]
ins, [SimpleTxOut] -> Set SimpleTxOut
forall a. Ord a => [a] -> Set a
Set.fromList ([SimpleTxOut] -> Set SimpleTxOut)
-> [SimpleTxOut] -> Set SimpleTxOut
forall a b. (a -> b) -> a -> b
$ (Integer -> SimpleTxOut) -> [Integer] -> [SimpleTxOut]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> SimpleTxOut
SimpleTxOut [Integer]
outs)