{-# 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.Mock.Ledger
import           Test.QuickCheck hiding (elements)
import           Test.ThreadNet.TxGen
import           Test.Util.QuickCheck

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

instance TxGen (SimpleBlock SimpleMockCrypto ext) where
  testGenTxs :: CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig (SimpleBlock SimpleMockCrypto ext)
-> TxGenExtra (SimpleBlock SimpleMockCrypto ext)
-> LedgerState (SimpleBlock SimpleMockCrypto ext)
-> Gen [GenTx (SimpleBlock SimpleMockCrypto ext)]
testGenTxs CoreNodeId
_coreNodeId NumCoreNodes
numCoreNodes SlotNo
curSlotNo TopLevelConfig (SimpleBlock SimpleMockCrypto ext)
_cfg () LedgerState (SimpleBlock SimpleMockCrypto ext)
ledgerState = do
      Int
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.
      Int
-> Gen (GenTx (SimpleBlock SimpleMockCrypto ext))
-> Gen [GenTx (SimpleBlock SimpleMockCrypto ext)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Gen (GenTx (SimpleBlock SimpleMockCrypto ext))
 -> Gen [GenTx (SimpleBlock SimpleMockCrypto ext)])
-> Gen (GenTx (SimpleBlock SimpleMockCrypto ext))
-> Gen [GenTx (SimpleBlock SimpleMockCrypto ext)]
forall a b. (a -> b) -> a -> b
$
        Tx -> GenTx (SimpleBlock SimpleMockCrypto ext)
forall c ext. Tx -> GenTx (SimpleBlock c ext)
mkSimpleGenTx (Tx -> GenTx (SimpleBlock SimpleMockCrypto ext))
-> Gen Tx -> Gen (GenTx (SimpleBlock SimpleMockCrypto ext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlotNo -> [Addr] -> Utxo -> Gen Tx
genSimpleTx SlotNo
curSlotNo [Addr]
addrs Utxo
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)
-> MockState (SimpleBlock SimpleMockCrypto ext)
forall c ext.
LedgerState (SimpleBlock c ext) -> MockState (SimpleBlock c ext)
simpleLedgerState LedgerState (SimpleBlock SimpleMockCrypto ext)
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
    Addr
sender    <- [Addr] -> Gen Addr
forall a. HasCallStack => [a] -> Gen a
elements [Addr]
senders
    Addr
recipient <- [Addr] -> Gen Addr
forall a. HasCallStack => [a] -> Gen a
elements ([Addr] -> Gen Addr) -> [Addr] -> Gen Addr
forall a b. (a -> b) -> a -> b
$ (Addr -> Bool) -> [Addr] -> [Addr]
forall a. (a -> Bool) -> [a] -> [a]
filter (Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
/= Addr
sender) [Addr]
addrs
    let assets :: [(TxIn, (Addr, Amount))]
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
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 :: Set TxIn
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
amount <- (Amount, Amount) -> Gen Amount
forall a. Random a => (a, a) -> Gen a
choose (Amount
1, Amount
fortune)
    let outRecipient :: (Addr, Amount)
outRecipient = (Addr
recipient, Amount
amount)
        outs :: [(Addr, 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
expiry <- [Expiry] -> Gen Expiry
forall a. HasCallStack => [a] -> Gen a
elements ([Expiry] -> Gen Expiry) -> [Expiry] -> Gen Expiry
forall a b. (a -> b) -> a -> b
$ (Maybe SlotNo -> Expiry) -> [Maybe SlotNo] -> [Expiry]
forall a b. (a -> b) -> [a] -> [b]
map Maybe SlotNo -> Expiry
mkExpiry ([Maybe SlotNo] -> [Expiry]) -> [Maybe SlotNo] -> [Expiry]
forall a b. (a -> b) -> a -> b
$ Maybe SlotNo
forall a. Maybe a
Nothing Maybe SlotNo -> [Maybe SlotNo] -> [Maybe SlotNo]
forall a. a -> [a] -> [a]
: (SlotNo -> Maybe SlotNo) -> [SlotNo] -> [Maybe SlotNo]
forall a b. (a -> b) -> [a] -> [b]
map SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just [SlotNo
0 .. SlotNo
10]
    Tx -> Gen Tx
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx -> Gen Tx) -> Tx -> Gen Tx
forall a b. (a -> b) -> a -> b
$ Expiry -> Set TxIn -> [(Addr, Amount)] -> Tx
Tx Expiry
expiry Set TxIn
ins [(Addr, Amount)]
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