diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs index 431557664f8..41d143eb5bf 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs @@ -85,7 +85,7 @@ data WalletBootEnv m = WalletBootEnv -- ^ Logger for the wallet. , genesisData :: Read.GenesisData -- ^ Genesis data for the wallet. - , networkEnv :: Network.NetworkEnv m Read.Block + , networkEnv :: Network.NetworkEnv m (Read.EraValue Read.Block) -- ^ Network environment for the wallet. } @@ -221,7 +221,8 @@ getCustomerHistories getCustomerHistories a w = Wallet.getCustomerHistories a <$> readWalletState w -rollForward :: WalletInstance -> NonEmpty Read.Block -> tip -> IO () +rollForward + :: WalletInstance -> NonEmpty (Read.EraValue Read.Block) -> tip -> IO () rollForward w blocks _nodeTip = onWalletState w $ Delta.update 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 index a7ad166fc8a..859d86c290f 100644 --- 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 @@ -48,7 +48,7 @@ import qualified Cardano.Wallet.Deposit.Write as Write ------------------------------------------------------------------------------} newNetworkEnvMock :: (MonadDelay m, MonadSTM m) - => m (NetworkEnv m Read.Block) + => m (NetworkEnv m (Read.Block Read.Conway)) newNetworkEnvMock = do mchain <- newTVarIO [] mtip <- newTVarIO Read.GenesisPoint 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 b60f83a2b5d..0152156023b 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 @@ -1,6 +1,8 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} module Cardano.Wallet.Deposit.IO.Network.Type ( NetworkEnv (..) + , mapBlock , ChainFollower (..) ) where @@ -8,6 +10,7 @@ import Prelude import Cardano.Wallet.Network ( ChainFollower (..) + , mapChainFollower ) import Control.Tracer ( Tracer @@ -45,6 +48,17 @@ data NetworkEnv m block = NetworkEnv } +mapBlock + :: Functor m + => (block1 -> block2) + -> NetworkEnv m block1 + -> NetworkEnv m block2 +mapBlock f NetworkEnv{chainSync,postTx} = NetworkEnv + { chainSync = \tr follower -> + chainSync tr (mapChainFollower id id id (fmap f) follower) + , postTx = postTx + } + {------------------------------------------------------------------------------- Errors -------------------------------------------------------------------------------} diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs index 00427b9ba67..71aabca2bab 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs @@ -175,11 +175,13 @@ fromXPubAndGenesis xpub knownCustomerCount _ = getWalletTip :: WalletState -> Read.ChainPoint getWalletTip = error "getWalletTip" -rollForwardMany :: NonEmpty Read.Block -> WalletState -> WalletState +rollForwardMany + :: NonEmpty (Read.EraValue Read.Block) -> WalletState -> WalletState rollForwardMany blocks w = foldl' (flip rollForwardOne) w blocks -rollForwardOne :: Read.Block -> WalletState -> WalletState -rollForwardOne block w = +rollForwardOne + :: Read.EraValue Read.Block -> WalletState -> WalletState +rollForwardOne (Read.EraValue block) w = w { utxoHistory = rollForwardUTxO isOurs block (utxoHistory w) , submissions = Delta.apply (Sbm.rollForward block) (submissions w) @@ -189,7 +191,8 @@ rollForwardOne block w = isOurs = Address.isOurs (addresses w) rollForwardUTxO - :: (Address -> Bool) -> Read.Block -> UTxOHistory -> UTxOHistory + :: Read.IsEra era + => (Address -> Bool) -> Read.Block era -> UTxOHistory -> UTxOHistory rollForwardUTxO isOurs block u = UTxOHistory.appendBlock slot deltaUTxO u where diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Balance.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Balance.hs index 4e34f833999..71716fb8225 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Balance.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Balance.hs @@ -57,7 +57,8 @@ availableUTxO u pending = -- -- Returns both a delta and the new value. applyBlock - :: IsOurs Read.Address -> Read.Block -> UTxO -> (DeltaUTxO, UTxO) + :: Read.IsEra era + => IsOurs Read.Address -> Read.Block era -> UTxO -> (DeltaUTxO, UTxO) applyBlock isOurs block u0 = (DeltaUTxO.concat $ reverse dus, u1) where diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Submissions.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Submissions.hs index 1e2d5f6ffcd..17e94c62d1e 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Submissions.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Submissions.hs @@ -62,7 +62,7 @@ add = undefined listInSubmission :: TxSubmissions -> Set Read.Tx listInSubmission = undefined -rollForward :: Read.Block -> DeltaTxSubmissions +rollForward :: Read.Block era -> DeltaTxSubmissions rollForward block = [ Sbm.RollForward tip txs ] where tip = undefined block 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 2b0f18a8943..f9b55fe81dc 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs @@ -8,7 +8,11 @@ -- -- TODO: Match this up with the @Read@ hierarchy. module Cardano.Wallet.Deposit.Read - ( Network (..) + ( Read.IsEra + , Read.EraValue (..) + , Read.Conway + + , Network (..) , Read.SlotNo , Read.ChainPoint (..) , Slot @@ -129,11 +133,10 @@ type TxWitness = () type BlockNo = Natural -- type Block = O.CardanoBlock O.StandardCrypto -data Block = Block +data Block era = Block { blockHeader :: BHeader - , transactions :: [Read.Tx Read.Conway] + , transactions :: [Read.Tx era] } - deriving (Eq, Show) data BHeader = BHeader { blockHeaderBody :: BHBody @@ -154,7 +157,7 @@ data BHBody = BHBody type HashHeader = Read.RawHeaderHash type HashBBody = () -getChainPoint :: Block -> Read.ChainPoint +getChainPoint :: Read.IsEra era => Block era -> Read.ChainPoint getChainPoint block = Read.BlockPoint { Read.slotNo = slot @@ -167,7 +170,7 @@ getChainPoint block = slot = slotNo bhBody -- | Create a new block from a sequence of transaction. -mockNextBlock :: Read.ChainPoint -> [Read.Tx Read.Conway] -> Block +mockNextBlock :: Read.ChainPoint -> [Read.Tx Read.Conway] -> Block Read.Conway mockNextBlock old txs = Block { blockHeader = BHeader diff --git a/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Blockchain.hs b/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Blockchain.hs index d126d3be4fe..54ecfc314e8 100644 --- a/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Blockchain.hs +++ b/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Blockchain.hs @@ -35,6 +35,7 @@ import Cardano.Wallet.Deposit.IO.Network.Mock ) import Cardano.Wallet.Deposit.IO.Network.Type ( NetworkEnv (..) + , mapBlock ) import Cardano.Wallet.Deposit.Pure ( BIP32Path @@ -68,14 +69,14 @@ assert False = error "Assertion failed!" -- | Environment for scenarios. data ScenarioEnv = ScenarioEnv { genesisData :: Read.GenesisData - , networkEnv :: NetworkEnv IO Read.Block + , networkEnv :: NetworkEnv IO (Read.EraValue Read.Block) , faucet :: Faucet } -- | Acquire and release a mock environment for a blockchain withScenarioEnvMock :: (ScenarioEnv -> IO a) -> IO a withScenarioEnvMock action = do - networkEnv <- newNetworkEnvMock + networkEnv <- mapBlock Read.EraValue <$> newNetworkEnvMock action $ ScenarioEnv { genesisData = error "TODO: Mock Genesis Data"