From fc54ab6a1d0b7b072ee43d15370b426c3414ad26 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 21 Nov 2024 14:24:42 +0100 Subject: [PATCH 1/3] Scaffold `Deposit.IO.Network.NodeToClient` module --- .../customer-deposit-wallet.cabal | 3 + .../src/Cardano/Wallet/Deposit/IO.hs | 4 +- .../Cardano/Wallet/Deposit/IO/Network/Mock.hs | 4 +- .../Wallet/Deposit/IO/Network/NodeToClient.hs | 129 ++++++++++++++++++ .../Cardano/Wallet/Deposit/IO/Network/Type.hs | 17 ++- .../src/Cardano/Wallet/Deposit/Read.hs | 4 + .../src/Cardano/Wallet/Deposit/Time.hs | 41 ++++-- 7 files changed, 179 insertions(+), 23 deletions(-) create mode 100644 lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/NodeToClient.hs diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal index 4145bb24565..e033dbed1e5 100644 --- a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal +++ b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal @@ -67,6 +67,7 @@ library , cardano-ledger-core , cardano-strict-containers , cardano-wallet + , cardano-wallet-launcher , cardano-wallet-network-layer , cardano-wallet-primitive , cardano-wallet-read ==0.2024.8.27 @@ -78,6 +79,7 @@ library , digest , fingertree , io-classes + , int-cast , lens , MonadRandom , monoidal-containers @@ -92,6 +94,7 @@ library Cardano.Wallet.Deposit.IO Cardano.Wallet.Deposit.IO.DB Cardano.Wallet.Deposit.IO.Network.Mock + Cardano.Wallet.Deposit.IO.Network.NodeToClient Cardano.Wallet.Deposit.IO.Network.Type Cardano.Wallet.Deposit.IO.Resource Cardano.Wallet.Deposit.IO.Resource.Event 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 66680a97bbb..4817623d782 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs @@ -98,7 +98,6 @@ import Data.Time import qualified Cardano.Wallet.Deposit.IO.Network.Type as Network import qualified Cardano.Wallet.Deposit.Pure as Wallet import qualified Cardano.Wallet.Deposit.Read as Read -import qualified Cardano.Wallet.Deposit.Time as Time import qualified Cardano.Wallet.Deposit.Write as Write import qualified Control.Concurrent.Async as Async import qualified Data.DBVar as DBVar @@ -326,8 +325,7 @@ createPayment -> WalletInstance -> IO (Either Wallet.ErrCreatePayment Write.Tx) createPayment a w = do - timeTranslation <- - Time.toTimeTranslation <$> Network.getTimeInterpreter network + timeTranslation <- Network.getTimeInterpreter network pparams <- Network.currentPParams network Wallet.createPayment pparams timeTranslation a <$> readWalletState w 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 393211ad801..0e368b02d0f 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 @@ -92,7 +92,7 @@ newNetworkEnvMock = do , currentPParams = pure $ Read.EraValue Read.mockPParamsConway , getTimeInterpreter = - pure Time.mockTimeInterpreter + pure $ Time.toTimeTranslationPure Time.mockTimeInterpreter , slotToUTCTime = pure Time.unsafeUTCTimeOfSlot - , utcTimeToSlot = pure . Just . Time.unsafeSlotOfUTCTime +-- , utcTimeToSlot = pure . Just . Time.unsafeSlotOfUTCTime } diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/NodeToClient.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/NodeToClient.hs new file mode 100644 index 00000000000..6c942c9f4a5 --- /dev/null +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/NodeToClient.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE LambdaCase #-} + +-- | +-- Copyright: © 2024 Cardano Foundation +-- License: Apache-2.0 +-- +-- Real implementation of a 'NetworkEnv'. +module Cardano.Wallet.Deposit.IO.Network.NodeToClient + ( withNetwork + + -- * Network Layer compatibility + , fromNetworkLayer + , NetworkLayer + , CardanoBlock + , StandardCrypto + ) where + +import Prelude + +import Cardano.Launcher.Node + ( CardanoNodeConn + ) +import Cardano.Ledger.Api + ( StandardCrypto + ) +import Cardano.Wallet.Deposit.IO.Network.Type + ( ErrPostTx (..) + , NetworkEnv (..) + , mapBlock + ) +import Cardano.Wallet.Deposit.Time + ( toTimeTranslation + ) +import Cardano.Wallet.Network + ( NetworkLayer + , mapChainFollower + ) +import Cardano.Wallet.Network.Implementation.Ouroboros + ( tunedForMainnetPipeliningStrategy + ) +import Cardano.Wallet.Primitive.Ledger.Shelley + ( CardanoBlock + , NodeToClientVersionData + ) +import Cardano.Wallet.Primitive.Slotting + ( snapshot + ) +import Cardano.Wallet.Primitive.SyncProgress + ( SyncTolerance + ) +import Cardano.Wallet.Primitive.Types.NetworkParameters + ( NetworkParameters + ) +import Cardano.Wallet.Read + ( chainPointFromChainTip + ) +import Control.Monad.Trans.Except + ( runExceptT + , withExceptT + ) +import Control.Tracer + ( nullTracer + ) +import GHC.Stack + ( HasCallStack + ) + +import qualified Cardano.Read.Ledger.Block.Block as Read +import qualified Cardano.Wallet.Deposit.Read as Read +import qualified Cardano.Wallet.Deposit.Time as Time +import qualified Cardano.Wallet.Network as NetworkLayer +import qualified Cardano.Wallet.Network.Implementation as NetworkLayer + +{----------------------------------------------------------------------------- + NodeToClient 'NetworkEnv' +------------------------------------------------------------------------------} + +withNetwork + :: HasCallStack + => NetworkParameters + -- ^ Initial blockchain parameters + -> CardanoNodeConn + -- ^ Socket for communicating with the node + -> NodeToClientVersionData + -- ^ Codecs for the node's client + -> SyncTolerance + -> (NetworkEnv IO (Read.EraValue Read.Block) -> IO a) + -- ^ Callback function with the network layer + -> IO a +withNetwork np conn vData syncTol act = + NetworkLayer.withNetworkLayer + nullTracer -- Using this for now + tunedForMainnetPipeliningStrategy + np + conn + vData + syncTol + (act . fromNetworkLayer) + +-- | Translate the old NetworkLayer to the new NetworkEnv interface +fromNetworkLayer + :: NetworkLayer.NetworkLayer IO Read.ConsensusBlock + -> NetworkEnv IO (Read.EraValue Read.Block) +fromNetworkLayer nl = mapBlock Read.fromConsensusBlock $ + NetworkEnv + { chainSync = \_tr follower -> do + -- TODO: Connect tracer + let follower' = mapChainFollower id id chainPointFromChainTip id follower + NetworkLayer.chainSync nl nullTracer follower' + return $ error "impossible: chainSync returned" + -- TODO: We can change the error type of 'NetworkLayer.postTx' it + -- doesn't need the ErrPostTxEraUnsupported case + , postTx = runExceptT . withExceptT translateErrPostTx . NetworkLayer.postTx nl + , currentPParams = + NetworkLayer.currentPParams nl + , getTimeInterpreter = toTimeTranslation (NetworkLayer.timeInterpreter nl) + , slotToUTCTime = Time.slotToUTCTime <$> snapshot ti +-- , utcTimeToSlot = pure . Just . Time.unsafeSlotOfUTCTime + } + + where + ti = NetworkLayer.timeInterpreter nl + + translateErrPostTx :: NetworkLayer.ErrPostTx -> ErrPostTx + translateErrPostTx = \case + NetworkLayer.ErrPostTxValidationError errorText -> ErrPostTxValidationError errorText + NetworkLayer.ErrPostTxMempoolFull -> ErrPostTxMempoolFull + NetworkLayer.ErrPostTxEraUnsupported _era -> + error "translateErrPostTx: ErrPostTxEraUnsupported should be impossible" 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 49ddf104e97..5b912b50dfb 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 @@ -12,9 +12,7 @@ import Prelude import Cardano.Wallet.Deposit.Read ( Slot - ) -import Cardano.Wallet.Deposit.Time - ( LookupTimeFromSlot + , WithOrigin ) import Cardano.Wallet.Network ( ChainFollower (..) @@ -61,14 +59,15 @@ data NetworkEnv m block = NetworkEnv :: m (Read.EraValue Read.PParams) -- ^ Current protocol paramters. , getTimeInterpreter - :: m Time.TimeInterpreter + :: m Time.TimeTranslation -- ^ Get the current 'TimeInterpreter' from the Cardano node. , slotToUTCTime - :: m LookupTimeFromSlot - -- ^ Try to convert a set of slots to their UTCTimes counterparts - , utcTimeToSlot - :: UTCTime - -> m (Maybe Slot) + :: m (Slot -> (Maybe (WithOrigin UTCTime))) + +-- -- ^ Try to convert a set of slots to their UTCTimes counterparts +-- , utcTimeToSlot +-- :: UTCTime +-- -> m (Maybe Slot) } mapBlock 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 5ae1cadf1e8..25463a01fcd 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs @@ -53,6 +53,10 @@ module Cardano.Wallet.Deposit.Read , mockNextBlock , Read.mockRawHeaderHash + , Read.ChainTip (..) + , Read.getChainTip + , Read.prettyChainTip + , Read.PParams (..) , Read.mockPParamsConway diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Time.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Time.hs index 1fc9bf8839b..bda67cb7b53 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Time.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Time.hs @@ -14,9 +14,12 @@ module Cardano.Wallet.Deposit.Time , PastHorizonException , mockTimeInterpreter + , slotToUTCTime + -- * from Write , Write.TimeTranslation , toTimeTranslation + , toTimeTranslationPure -- * wishlist , LookupTimeFromSlot @@ -32,10 +35,13 @@ import Prelude import Cardano.Wallet.Primitive.Slotting ( PastHorizonException , StartTime (..) + , hoistTimeInterpreter + , interpretQuery , mkSingleEraInterpreter ) import Cardano.Wallet.Primitive.Slotting.TimeTranslation - ( toTimeTranslationPure + ( toTimeTranslation + , toTimeTranslationPure ) import Cardano.Wallet.Primitive.Types.SlottingParameters ( ActiveSlotCoefficient (..) @@ -51,6 +57,9 @@ import Cardano.Wallet.Read import Data.Functor.Identity ( Identity (..) ) +import Data.IntCast + ( intCastMaybe + ) import Data.Quantity ( Quantity (..) ) @@ -69,10 +78,10 @@ import qualified Cardano.Write.Tx as Write {----------------------------------------------------------------------------- TimeInterpreter ------------------------------------------------------------------------------} -type TimeInterpreter = Primitive.TimeInterpreter Identity +type TimeInterpreter = Primitive.TimeInterpreter (Either PastHorizonException) -mockTimeInterpreter :: TimeInterpreter -mockTimeInterpreter = +mockTimeInterpreter :: Primitive.TimeInterpreter Identity +mockTimeInterpreter = hoistTimeInterpreter (pure . runIdentity) $ mkSingleEraInterpreter (StartTime $ UTCTime (toEnum 0) 0) mockSlottingParameters @@ -85,15 +94,29 @@ mockSlottingParameters = SlottingParameters , getSecurityParameter = Quantity 2_160 } +type LookupTimeFromSlot = Slot -> Maybe (WithOrigin UTCTime) + {----------------------------------------------------------------------------- TimeInterpreter ------------------------------------------------------------------------------} -toTimeTranslation :: TimeInterpreter -> Write.TimeTranslation -toTimeTranslation = toTimeTranslationPure - -type LookupTimeFromSlot = Slot -> Maybe (WithOrigin UTCTime) - +-- TODO: Is this the start time of the slot? +slotToUTCTime :: TimeInterpreter -> LookupTimeFromSlot +slotToUTCTime _ti Origin = Just Origin --either (const Nothing) Just $ interpretQuery ti $ Primitive.slotToUTCTime minBound +slotToUTCTime ti (At s) = either (const Nothing) (Just . At) . interpretQuery ti . Primitive.slotToUTCTime =<< convertSlotNo s + where + convertSlotNo :: SlotNo -> Maybe Primitive.SlotNo + convertSlotNo (SlotNo n) = Primitive.SlotNo <$> intCastMaybe n + +--utcTimeToSlot :: TimeInterpreter -> UTCTime -> Maybe Slot +--utcTimeToSlot ti t = either (const Nothing) Just . interpretQuery ti $ do +-- ongoingSlotAt $ toRelativeTime startTime t +-- where +-- convertSlotNo :: Primitive.SlotNo -> SlotNo +-- convertSlotNo (Primitive.SlotNo n) = SlotNo $ intCast n + +-- TODO: Rename to mainnetUTCTimeOfSlot +-- TODO: Move to tests? unsafeUTCTimeOfSlot :: Slot -> Maybe (WithOrigin UTCTime) unsafeUTCTimeOfSlot Origin = Just Origin unsafeUTCTimeOfSlot (At (SlotNo n)) = From f3464603192c49682b4510bfef16ce3c7375b3ac Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Mon, 25 Nov 2024 11:51:36 +0100 Subject: [PATCH 2/3] Use real new `newBootEnv` in `Cardano.Wallet.Application` --- .../rest/Cardano/Wallet/Deposit/REST/Start.hs | 26 +++++++++++++++++++ lib/exe/lib/Cardano/Wallet/Application.hs | 20 +++++++------- 2 files changed, 36 insertions(+), 10 deletions(-) diff --git a/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs b/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs index 62e6ec433e3..1743b0d2612 100644 --- a/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs +++ b/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs @@ -4,6 +4,7 @@ module Cardano.Wallet.Deposit.REST.Start ( loadDepositWalletFromDisk , newFakeBootEnv + , newBootEnv , mockFundTheWallet ) where @@ -16,6 +17,12 @@ import Cardano.Wallet.Deposit.IO import Cardano.Wallet.Deposit.IO.Network.Mock ( newNetworkEnvMock ) +import Cardano.Wallet.Deposit.IO.Network.NodeToClient + ( CardanoBlock + , NetworkLayer + , StandardCrypto + , fromNetworkLayer + ) import Cardano.Wallet.Deposit.IO.Network.Type ( NetworkEnv , mapBlock @@ -130,3 +137,22 @@ newFakeBootEnv genesisFile = do genesisData' . mapBlock Read.EraValue <$> newNetworkEnvMock + +newBootEnv + :: Maybe FilePath + -> NetworkLayer IO (CardanoBlock StandardCrypto) + -> IO (WalletBootEnv IO) +newBootEnv genesisFile nl = do + eGenesisData <- runExceptT $ case genesisFile of + Nothing -> ExceptT $ pure $ Right Read.mockGenesisDataMainnet + Just file -> fst <$> Byron.readGenesisData file + print genesisFile + print eGenesisData + print $ Read.getNetworkId <$> eGenesisData + case eGenesisData of + Left e -> error $ show e + Right genesisData' -> + return $ WalletBootEnv + (show >$< stdoutTracer) + genesisData' + (fromNetworkLayer nl) diff --git a/lib/exe/lib/Cardano/Wallet/Application.hs b/lib/exe/lib/Cardano/Wallet/Application.hs index 43d7c2d109d..7fdb3048512 100644 --- a/lib/exe/lib/Cardano/Wallet/Application.hs +++ b/lib/exe/lib/Cardano/Wallet/Application.hs @@ -106,7 +106,7 @@ import Cardano.Wallet.Deposit.REST ) import Cardano.Wallet.Deposit.REST.Start ( loadDepositWalletFromDisk - , newFakeBootEnv + , newBootEnv ) import Cardano.Wallet.Flavor ( CredFromOf @@ -383,7 +383,7 @@ serveWallet eDepositUiSocket <- bindDepositUiSocket eDepositSocket <- bindDepositSocket eShelleySocket <- bindApiSocket - fakeBootEnv <- lift $ newFakeBootEnv depositByronGenesisFile + bootEnv <- lift $ newBootEnv depositByronGenesisFile netLayer callCC $ \exit -> do case eShelleyUiSocket of Left err -> do @@ -431,7 +431,7 @@ serveWallet >$< applicationTracer ) databaseDir' - fakeBootEnv + bootEnv resource ui <- Ui.withUILayer 1 resource REST.onResourceChange @@ -444,7 +444,7 @@ serveWallet let uiService = startDepositUiServer ui - fakeBootEnv + bootEnv databaseDir' socket sNetwork @@ -475,7 +475,7 @@ serveWallet >$< applicationTracer ) databaseDir' - fakeBootEnv + bootEnv resource pure (databaseDir', resource) Just (databaseDir', w) -> @@ -483,7 +483,7 @@ serveWallet let depositService = startDepositServer resource - fakeBootEnv + bootEnv databaseDir' socket ContT $ \k -> @@ -624,7 +624,7 @@ serveWallet -> IO () startDepositServer resource - fakeBootEnv + bootEnv databaseDir' socket = do @@ -635,7 +635,7 @@ serveWallet $ Deposit.server (DepositApplicationLog >$< applicationTracer) databaseDir' - fakeBootEnv + bootEnv resource start serverSettings @@ -657,7 +657,7 @@ serveWallet -> IO () startDepositUiServer ui - fakeBootEnv + bootEnv databaseDir' socket _proxy @@ -670,7 +670,7 @@ serveWallet $ DepositUi.serveUI (DepositUIApplicationLog >$< applicationTracer) ui - fakeBootEnv + bootEnv databaseDir' (PageConfig "" "Deposit Cardano Wallet") _proxy From 295f656cc45a5ed64279eef7dc8013e95934d7a6 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 28 Nov 2024 14:54:22 +0100 Subject: [PATCH 3/3] Apply suggestions from code review --- .../customer-deposit-wallet.cabal | 1 - .../rest/Cardano/Wallet/Deposit/REST/Start.hs | 22 --------- .../src/Cardano/Wallet/Deposit/IO.hs | 2 +- .../Cardano/Wallet/Deposit/IO/Network/Mock.hs | 3 +- .../Wallet/Deposit/IO/Network/NodeToClient.hs | 47 +------------------ .../Cardano/Wallet/Deposit/IO/Network/Type.hs | 6 +-- .../src/Cardano/Wallet/Deposit/Time.hs | 17 +++---- 7 files changed, 11 insertions(+), 87 deletions(-) diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal index e033dbed1e5..dd76cdbac61 100644 --- a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal +++ b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal @@ -67,7 +67,6 @@ library , cardano-ledger-core , cardano-strict-containers , cardano-wallet - , cardano-wallet-launcher , cardano-wallet-network-layer , cardano-wallet-primitive , cardano-wallet-read ==0.2024.8.27 diff --git a/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs b/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs index 1743b0d2612..68f1cebbe0f 100644 --- a/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs +++ b/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs @@ -3,7 +3,6 @@ module Cardano.Wallet.Deposit.REST.Start ( loadDepositWalletFromDisk - , newFakeBootEnv , newBootEnv , mockFundTheWallet ) @@ -14,9 +13,6 @@ import Prelude import Cardano.Wallet.Deposit.IO ( WalletBootEnv (..) ) -import Cardano.Wallet.Deposit.IO.Network.Mock - ( newNetworkEnvMock - ) import Cardano.Wallet.Deposit.IO.Network.NodeToClient ( CardanoBlock , NetworkLayer @@ -25,7 +21,6 @@ import Cardano.Wallet.Deposit.IO.Network.NodeToClient ) import Cardano.Wallet.Deposit.IO.Network.Type ( NetworkEnv - , mapBlock , postTx ) import Cardano.Wallet.Deposit.REST @@ -121,23 +116,6 @@ mockFundTheWallet network resource = flip runWalletResourceM resource $ do Right () <- liftIO $ postTx network tx pure () -newFakeBootEnv :: Maybe FilePath -> IO (WalletBootEnv IO) -newFakeBootEnv genesisFile = do - eGenesisData <- runExceptT $ case genesisFile of - Nothing -> ExceptT $ pure $ Right Read.mockGenesisDataMainnet - Just file -> fst <$> Byron.readGenesisData file - print genesisFile - print eGenesisData - print $ Read.getNetworkId <$> eGenesisData - case eGenesisData of - Left e -> error $ show e - Right genesisData' -> - WalletBootEnv - (show >$< stdoutTracer) - genesisData' - . mapBlock Read.EraValue - <$> newNetworkEnvMock - newBootEnv :: Maybe FilePath -> NetworkLayer IO (CardanoBlock StandardCrypto) 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 4817623d782..bd54f40f69c 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs @@ -325,7 +325,7 @@ createPayment -> WalletInstance -> IO (Either Wallet.ErrCreatePayment Write.Tx) createPayment a w = do - timeTranslation <- Network.getTimeInterpreter network + timeTranslation <- Network.getTimeTranslation network pparams <- Network.currentPParams network Wallet.createPayment pparams timeTranslation a <$> readWalletState w 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 0e368b02d0f..ee3726965dc 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 @@ -91,8 +91,7 @@ newNetworkEnvMock = do pure $ Right () , currentPParams = pure $ Read.EraValue Read.mockPParamsConway - , getTimeInterpreter = + , getTimeTranslation = pure $ Time.toTimeTranslationPure Time.mockTimeInterpreter , slotToUTCTime = pure Time.unsafeUTCTimeOfSlot --- , utcTimeToSlot = pure . Just . Time.unsafeSlotOfUTCTime } diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/NodeToClient.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/NodeToClient.hs index 6c942c9f4a5..d6f8632980e 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/NodeToClient.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/NodeToClient.hs @@ -6,10 +6,7 @@ -- -- Real implementation of a 'NetworkEnv'. module Cardano.Wallet.Deposit.IO.Network.NodeToClient - ( withNetwork - - -- * Network Layer compatibility - , fromNetworkLayer + ( fromNetworkLayer , NetworkLayer , CardanoBlock , StandardCrypto @@ -17,9 +14,6 @@ module Cardano.Wallet.Deposit.IO.Network.NodeToClient import Prelude -import Cardano.Launcher.Node - ( CardanoNodeConn - ) import Cardano.Ledger.Api ( StandardCrypto ) @@ -35,22 +29,12 @@ import Cardano.Wallet.Network ( NetworkLayer , mapChainFollower ) -import Cardano.Wallet.Network.Implementation.Ouroboros - ( tunedForMainnetPipeliningStrategy - ) import Cardano.Wallet.Primitive.Ledger.Shelley ( CardanoBlock - , NodeToClientVersionData ) import Cardano.Wallet.Primitive.Slotting ( snapshot ) -import Cardano.Wallet.Primitive.SyncProgress - ( SyncTolerance - ) -import Cardano.Wallet.Primitive.Types.NetworkParameters - ( NetworkParameters - ) import Cardano.Wallet.Read ( chainPointFromChainTip ) @@ -61,42 +45,16 @@ import Control.Monad.Trans.Except import Control.Tracer ( nullTracer ) -import GHC.Stack - ( HasCallStack - ) import qualified Cardano.Read.Ledger.Block.Block as Read import qualified Cardano.Wallet.Deposit.Read as Read import qualified Cardano.Wallet.Deposit.Time as Time import qualified Cardano.Wallet.Network as NetworkLayer -import qualified Cardano.Wallet.Network.Implementation as NetworkLayer {----------------------------------------------------------------------------- NodeToClient 'NetworkEnv' ------------------------------------------------------------------------------} -withNetwork - :: HasCallStack - => NetworkParameters - -- ^ Initial blockchain parameters - -> CardanoNodeConn - -- ^ Socket for communicating with the node - -> NodeToClientVersionData - -- ^ Codecs for the node's client - -> SyncTolerance - -> (NetworkEnv IO (Read.EraValue Read.Block) -> IO a) - -- ^ Callback function with the network layer - -> IO a -withNetwork np conn vData syncTol act = - NetworkLayer.withNetworkLayer - nullTracer -- Using this for now - tunedForMainnetPipeliningStrategy - np - conn - vData - syncTol - (act . fromNetworkLayer) - -- | Translate the old NetworkLayer to the new NetworkEnv interface fromNetworkLayer :: NetworkLayer.NetworkLayer IO Read.ConsensusBlock @@ -113,9 +71,8 @@ fromNetworkLayer nl = mapBlock Read.fromConsensusBlock $ , postTx = runExceptT . withExceptT translateErrPostTx . NetworkLayer.postTx nl , currentPParams = NetworkLayer.currentPParams nl - , getTimeInterpreter = toTimeTranslation (NetworkLayer.timeInterpreter nl) + , getTimeTranslation = toTimeTranslation (NetworkLayer.timeInterpreter nl) , slotToUTCTime = Time.slotToUTCTime <$> snapshot ti --- , utcTimeToSlot = pure . Just . Time.unsafeSlotOfUTCTime } where 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 5b912b50dfb..8e3d92cff59 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 @@ -58,16 +58,12 @@ data NetworkEnv m block = NetworkEnv , currentPParams :: m (Read.EraValue Read.PParams) -- ^ Current protocol paramters. - , getTimeInterpreter + , getTimeTranslation :: m Time.TimeTranslation -- ^ Get the current 'TimeInterpreter' from the Cardano node. , slotToUTCTime :: m (Slot -> (Maybe (WithOrigin UTCTime))) --- -- ^ Try to convert a set of slots to their UTCTimes counterparts --- , utcTimeToSlot --- :: UTCTime --- -> m (Maybe Slot) } mapBlock diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Time.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Time.hs index bda67cb7b53..b47596e6b2b 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Time.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Time.hs @@ -94,27 +94,22 @@ mockSlottingParameters = SlottingParameters , getSecurityParameter = Quantity 2_160 } -type LookupTimeFromSlot = Slot -> Maybe (WithOrigin UTCTime) - {----------------------------------------------------------------------------- TimeInterpreter ------------------------------------------------------------------------------} --- TODO: Is this the start time of the slot? +type LookupTimeFromSlot = Slot -> Maybe (WithOrigin UTCTime) + +-- | Look up the UTCTime corresponding to the start of the provided `Slot`. +-- +-- TODO: Check roundtrip properties once we need to implement the corresponding 'utcTimeToSlot'. slotToUTCTime :: TimeInterpreter -> LookupTimeFromSlot -slotToUTCTime _ti Origin = Just Origin --either (const Nothing) Just $ interpretQuery ti $ Primitive.slotToUTCTime minBound +slotToUTCTime _ti Origin = Just Origin slotToUTCTime ti (At s) = either (const Nothing) (Just . At) . interpretQuery ti . Primitive.slotToUTCTime =<< convertSlotNo s where convertSlotNo :: SlotNo -> Maybe Primitive.SlotNo convertSlotNo (SlotNo n) = Primitive.SlotNo <$> intCastMaybe n ---utcTimeToSlot :: TimeInterpreter -> UTCTime -> Maybe Slot ---utcTimeToSlot ti t = either (const Nothing) Just . interpretQuery ti $ do --- ongoingSlotAt $ toRelativeTime startTime t --- where --- convertSlotNo :: Primitive.SlotNo -> SlotNo --- convertSlotNo (Primitive.SlotNo n) = SlotNo $ intCast n - -- TODO: Rename to mainnetUTCTimeOfSlot -- TODO: Move to tests? unsafeUTCTimeOfSlot :: Slot -> Maybe (WithOrigin UTCTime)