{-# 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

{-------------------------------------------------------------------------------
  TxGen SimpleBlock
-------------------------------------------------------------------------------}

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)
    -- We don't update the UTxO after each transaction, so some of the
    -- generated transactions could very well be invalid.
    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 -- people with funds
  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)]
  -- generate transactions within several slots in the future or never
  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