diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal index 2f92af6fcfa..b86e39804e8 100644 --- a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal +++ b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal @@ -57,6 +57,7 @@ library , contra-tracer , delta-store , delta-types + , io-classes , iohk-monitoring-extra ^>=0.1 , persistent >= 2.13 && < 2.15 , sqlite-simple >= 0.4.19.0 && < 0.5 @@ -66,6 +67,7 @@ library exposed-modules: Cardano.Wallet.Deposit.IO Cardano.Wallet.Deposit.IO.DB + Cardano.Wallet.Deposit.IO.Network.Mock Cardano.Wallet.Deposit.IO.Network.Type Cardano.Wallet.Deposit.Pure Cardano.Wallet.Deposit.Pure.Balance diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs new file mode 100644 index 00000000000..11779cbff30 --- /dev/null +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs @@ -0,0 +1,114 @@ +{-| +Copyright: © 2024 Cardano Foundation +License: Apache-2.0 + +Mock implementation of a 'NetworkEnv'. +-} +module Cardano.Wallet.Deposit.IO.Network.Mock + ( newNetworkEnvMock + ) where + +import Prelude + +import Cardano.Wallet.Deposit.IO.Network.Type + ( NetworkEnv (..) + ) +import Cardano.Wallet.Network + ( ChainFollower (..) + ) +import Control.Concurrent.Class.MonadSTM + ( MonadSTM + , atomically + , modifyTVar + , newTVarIO + , readTVar + , readTVarIO + , writeTVar + ) +import Control.Monad + ( forever + ) +import Control.Monad.Class.MonadTimer + ( MonadDelay + , threadDelay + ) +import Data.Foldable + ( for_ + ) +import Data.List.NonEmpty + ( NonEmpty ((:|)) + ) + +import qualified Cardano.Wallet.Deposit.Read as Read +import qualified Cardano.Wallet.Deposit.Write as Write + +{----------------------------------------------------------------------------- + Mock implementation of 'NetworkEnv' +------------------------------------------------------------------------------} +newNetworkEnvMock + :: (MonadDelay m, MonadSTM m) + => m (NetworkEnv m Read.Block) +newNetworkEnvMock = do + mchain <- newTVarIO [] + mtip <- newTVarIO genesis + mfollowers <- newTVarIO [] + + let registerAndUpdate follower = do + _ <- rollBackward follower genesis + (chain, tip) <- atomically $ do + modifyTVar mfollowers (follower:) + (,) <$> readTVar mchain <*> readTVar mtip + case reverse chain of + [] -> pure () + (b:bs) -> rollForward follower (b :| bs) tip + + let forgeBlock tx = atomically $ do + tipOld <- readTVar mtip + let txRead = Write.toReadTx (Write.mockTxId tipOld) tx + blockNew = mkNextBlock tipOld [txRead] + tipNew = getBlockPoint blockNew + writeTVar mtip tipNew + modifyTVar mchain (blockNew:) + pure (blockNew, tipNew) + + let broadcast block tip = do + followers <- readTVarIO mfollowers + for_ followers $ \follower -> + rollForward follower (block :| []) tip + + pure NetworkEnv + { chainSync = \_ follower -> do + registerAndUpdate follower + forever $ threadDelay 1000000 + , postTx = \tx -> do + (block, tip) <- forgeBlock tx + broadcast block tip + -- brief delay to account for asynchronous chain followers + threadDelay 10 + pure $ Right () + } + +genesis :: Read.ChainPoint +genesis = Read.Origin + +getBlockPoint :: Read.Block -> Read.ChainPoint +getBlockPoint = Read.At . Read.slot . Read.blockHeaderBody . Read.blockHeader + +mkNextBlock :: Read.ChainPoint -> [Read.Tx] -> Read.Block +mkNextBlock tipOld txs = + Read.Block + { Read.blockHeader = Read.BHeader + { Read.blockHeaderBody = Read.BHBody + { Read.prev = Nothing + , Read.blockno = toEnum $ fromEnum slotNext + , Read.slot = slotNext + , Read.bhash = () + } + , Read.blockHeaderSignature = () + } + , Read.transactions = txs + } + where + slotNext = case tipOld of + Read.Origin -> 1 + Read.At n -> succ n diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Type.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Type.hs index 8203ff75168..b60f83a2b5d 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Type.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Type.hs @@ -26,6 +26,7 @@ import GHC.Generics ) import qualified Cardano.Wallet.Deposit.Read as Read +import qualified Cardano.Wallet.Deposit.Write as Write {----------------------------------------------------------------------------- Type @@ -39,7 +40,7 @@ data NetworkEnv m block = NetworkEnv -- ^ Run the chain-sync mini-protocol (forever). , postTx - :: Read.Tx -> m (Either ErrPostTx ()) + :: Write.Tx -> m (Either ErrPostTx ()) -- ^ Post a transaction to the Cardano network. } diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs index 54fba106cda..293e3fa91e9 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs @@ -72,7 +72,10 @@ data Network = Testnet | Mainnet -- Spec: type Slot = Natural type Slot = W.SlotNo -data ChainPoint = Origin | At Slot +data ChainPoint + = Origin + | At Slot + deriving (Eq, Ord, Show) -- newtype Addr = Addr { getAddressBytes :: ByteString } -- deriving (Eq, Show) diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs index 045596d15e0..1ac169b3267 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} + -- | Indirection module that re-exports types -- used for writing transactions to the blockchain, -- in the most recent and the next future eras. @@ -11,11 +14,27 @@ module Cardano.Wallet.Deposit.Write , TxId , Tx (..) , TxBody (..) + , TxIn + , TxOut , TxWitness + + -- * Helper functions + , mkAda + , mkTxOut + , mockTxId + , toReadTx ) where import Prelude +import Cardano.Wallet.Deposit.Read + ( Address + , TxId + , TxIn + , TxOut + , TxWitness + , Value + ) import Data.Map ( Map ) @@ -23,10 +42,15 @@ import Data.Set ( Set ) -import Cardano.Wallet.Deposit.Read hiding - ( Tx - , TxBody - ) +import qualified Cardano.Wallet.Deposit.Read as Read +import qualified Cardano.Wallet.Primitive.Types.Coin as W +import qualified Cardano.Wallet.Primitive.Types.Hash as W +import qualified Cardano.Wallet.Primitive.Types.TokenBundle as W +import qualified Cardano.Wallet.Primitive.Types.Tx as W +import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set {----------------------------------------------------------------------------- Type definitions @@ -41,7 +65,41 @@ data Tx = Tx data TxBody = TxBody { spendInputs :: Set TxIn , collInputs :: Set TxIn - , txouts :: Map Ix TxOut + , txouts :: Map Read.Ix TxOut , collRet :: Maybe TxOut } deriving (Eq, Ord, Show) + +mkAda :: Integer -> Value +mkAda = W.fromCoin . W.unsafeFromIntegral + +mkTxOut :: Address -> Value -> TxOut +mkTxOut = W.TxOut + +toReadTx :: TxId -> Tx -> Read.Tx +toReadTx txid Tx{txbody=TxBody{..}} = + W.Tx + { W.txId = + W.Hash txid + , W.txCBOR = + Nothing + , W.fee = + Nothing + , W.resolvedInputs = + map (,Nothing) $ Set.toList spendInputs + , W.resolvedCollateralInputs = + map (,Nothing) $ Set.toList collInputs + , W.outputs = + map snd $ Map.toAscList txouts + , W.collateralOutput = + collRet + , W.withdrawals = + mempty + , W.metadata = + Nothing + , W.scriptValidity = + Nothing + } + +mockTxId :: Show a => a -> TxId +mockTxId = B8.pack . show