{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.ThreadNet.TxGen.Mock () where
import Control.Monad (replicateM)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.Tables
import Ouroboros.Consensus.Mock.Ledger
import Test.QuickCheck
import Test.ThreadNet.TxGen
instance TxGen (SimpleBlock SimpleMockCrypto ext) where
testGenTxs :: CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig (SimpleBlock SimpleMockCrypto ext)
-> TxGenExtra (SimpleBlock SimpleMockCrypto ext)
-> LedgerState (SimpleBlock SimpleMockCrypto ext) ValuesMK
-> Gen [GenTx (SimpleBlock SimpleMockCrypto ext)]
testGenTxs CoreNodeId
_coreNodeId NumCoreNodes
numCoreNodes SlotNo
curSlotNo TopLevelConfig (SimpleBlock SimpleMockCrypto ext)
_cfg () LedgerState (SimpleBlock SimpleMockCrypto ext) ValuesMK
ledgerState = do
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
20)
replicateM n $
mkSimpleGenTx <$> genSimpleTx curSlotNo addrs utxo
where
addrs :: [Addr]
addrs :: [Addr]
addrs = Map Addr NodeId -> [Addr]
forall k a. Map k a -> [k]
Map.keys (Map Addr NodeId -> [Addr]) -> Map Addr NodeId -> [Addr]
forall a b. (a -> b) -> a -> b
$ NumCoreNodes -> Map Addr NodeId
mkAddrDist NumCoreNodes
numCoreNodes
utxo :: Utxo
utxo :: Utxo
utxo = MockState (SimpleBlock SimpleMockCrypto ext) -> Utxo
forall blk. MockState blk -> Utxo
mockUtxo (MockState (SimpleBlock SimpleMockCrypto ext) -> Utxo)
-> MockState (SimpleBlock SimpleMockCrypto ext) -> Utxo
forall a b. (a -> b) -> a -> b
$ LedgerState (SimpleBlock SimpleMockCrypto ext) EmptyMK
-> MockState (SimpleBlock SimpleMockCrypto ext)
forall c ext (mk :: MapKind).
LedgerState (SimpleBlock c ext) mk -> MockState (SimpleBlock c ext)
simpleLedgerState (LedgerState (SimpleBlock SimpleMockCrypto ext) EmptyMK
-> MockState (SimpleBlock SimpleMockCrypto ext))
-> LedgerState (SimpleBlock SimpleMockCrypto ext) EmptyMK
-> MockState (SimpleBlock SimpleMockCrypto ext)
forall a b. (a -> b) -> a -> b
$ LedgerState (SimpleBlock SimpleMockCrypto ext) ValuesMK
-> LedgerState (SimpleBlock SimpleMockCrypto ext) EmptyMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l ValuesMK -> l EmptyMK
stowLedgerTables LedgerState (SimpleBlock SimpleMockCrypto ext) ValuesMK
ledgerState
genSimpleTx :: SlotNo -> [Addr] -> Utxo -> Gen Tx
genSimpleTx :: SlotNo -> [Addr] -> Utxo -> Gen Tx
genSimpleTx SlotNo
curSlotNo [Addr]
addrs Utxo
u = do
let senders :: [Addr]
senders = Set Addr -> [Addr]
forall a. Set a -> [a]
Set.toList (Set Addr -> [Addr]) -> (Utxo -> Set Addr) -> Utxo -> [Addr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Addr] -> Set Addr
forall a. Ord a => [a] -> Set a
Set.fromList ([Addr] -> Set Addr) -> (Utxo -> [Addr]) -> Utxo -> Set Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Addr, Amount) -> Addr) -> [(Addr, Amount)] -> [Addr]
forall a b. (a -> b) -> [a] -> [b]
map (Addr, Amount) -> Addr
forall a b. (a, b) -> a
fst ([(Addr, Amount)] -> [Addr])
-> (Utxo -> [(Addr, Amount)]) -> Utxo -> [Addr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utxo -> [(Addr, Amount)]
forall k a. Map k a -> [a]
Map.elems (Utxo -> [Addr]) -> Utxo -> [Addr]
forall a b. (a -> b) -> a -> b
$ Utxo
u
sender <- [Addr] -> Gen Addr
forall a. HasCallStack => [a] -> Gen a
elements [Addr]
senders
recipient <- elements $ filter (/= sender) addrs
let assets = ((TxIn, (Addr, Amount)) -> Bool)
-> [(TxIn, (Addr, Amount))] -> [(TxIn, (Addr, Amount))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(TxIn
_, (Addr
a, Amount
_)) -> Addr
a Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
sender) ([(TxIn, (Addr, Amount))] -> [(TxIn, (Addr, Amount))])
-> [(TxIn, (Addr, Amount))] -> [(TxIn, (Addr, Amount))]
forall a b. (a -> b) -> a -> b
$ Utxo -> [(TxIn, (Addr, Amount))]
forall k a. Map k a -> [(k, a)]
Map.toList Utxo
u
fortune = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount
c | (TxIn
_, (Addr
_, Amount
c)) <- [(TxIn, (Addr, Amount))]
assets]
ins = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList ([TxIn] -> Set TxIn) -> [TxIn] -> Set TxIn
forall a b. (a -> b) -> a -> b
$ ((TxIn, (Addr, Amount)) -> TxIn)
-> [(TxIn, (Addr, Amount))] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, (Addr, Amount)) -> TxIn
forall a b. (a, b) -> a
fst [(TxIn, (Addr, Amount))]
assets
amount <- choose (1, fortune)
let outRecipient = (Addr
recipient, Amount
amount)
outs = if Amount
amount Amount -> Amount -> Bool
forall a. Eq a => a -> a -> Bool
== Amount
fortune
then [(Addr, Amount)
outRecipient]
else [(Addr, Amount)
outRecipient, (Addr
sender, Amount
fortune Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- Amount
amount)]
expiry <- elements $ map mkExpiry $ Nothing : map Just [0 .. 10]
return $ Tx expiry ins outs
where
mkExpiry :: Maybe SlotNo -> Expiry
mkExpiry :: Maybe SlotNo -> Expiry
mkExpiry = \case
Maybe SlotNo
Nothing -> Expiry
DoNotExpire
Just SlotNo
delta -> SlotNo -> Expiry
ExpireAtOnsetOf (SlotNo -> Expiry) -> SlotNo -> Expiry
forall a b. (a -> b) -> a -> b
$ SlotNo
curSlotNo SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
delta