[ADP-3229] Move wallet network implementation to network lib (#4264)

- [x] Move `GenesisParameters` to primitive lib - [x] Move `NetworkParameters` to primitive lib - [x] Move `Byron` compatibility modules to primitive lib, rename to` Primitive.Ledger.Byron` - [x] Move `Shelley` compatibility module to primitive lib , rename to` Primitive.Ledger.Shelley` - [x] Split `CompatibilitySpec` (because it's containing stuff that has nothing to do with `Compatibility` module, ehm) - [x] Move the `CompatibilitySpec` part that pertains to Compatibility to primitive lib - [x] Split `UnliftIO.Compat` and move `coerceHandlers` to network-layer lib - [x] Move `Ouroboros.Network.Client.Wallet` to network-layer lib , rename to `Network.Implementation.Ouroboros` - [x] Move network implementation to network-layer lib and rename as `Network.Implementation` ADP-3229
cardano-foundation · Nov 27, 2023 · f90a261 · f90a261
2 parents ec442aa + 3b79497
commit f90a261
Show file tree

Hide file tree

Showing 28 changed files with 998 additions and 743 deletions.
diff --git a/lib/network-layer/cardano-wallet-network-layer.cabal b/lib/network-layer/cardano-wallet-network-layer.cabal
@@ -23,38 +23,49 @@ common warnings
 library
   import:           warnings
   exposed-modules:
-    Cardano.Wallet.Network.Logging.Aggregation
-    Cardano.Wallet.Network.Logging
     Cardano.Wallet.Network
+    Cardano.Wallet.Network.Implementation
+    Cardano.Wallet.Network.Implementation.Ouroboros
+    Cardano.Wallet.Network.Implementation.UnliftIO
+    Cardano.Wallet.Network.Logging
+    Cardano.Wallet.Network.Logging.Aggregation
 
   -- other-modules:
   -- other-extensions:
   build-depends:
-    , base                         ^>=4.14.3.0
+    , base                           ^>=4.14.3.0
     , bytestring
     , cardano-api
     , cardano-balance-tx:internal
+    , cardano-crypto-class
     , cardano-ledger-core
+    , cardano-ledger-shelley
     , cardano-slotting
     , cardano-wallet-launcher
     , cardano-wallet-primitive
     , cardano-wallet-read
     , cborg
     , containers
     , contra-tracer
+    , exceptions
     , fmt
     , generics-sop
     , io-classes
     , iohk-monitoring
     , iohk-monitoring-extra
     , memory
+    , mtl
     , network-mux
     , nothunks
     , ouroboros-consensus
     , ouroboros-consensus-cardano
+    , ouroboros-consensus-diffusion
+    , ouroboros-consensus-protocol
+    , ouroboros-network
     , ouroboros-network-api
     , ouroboros-network-framework
     , ouroboros-network-protocols
+    , retry
     , safe
     , strict-stm
     , text
@@ -63,6 +74,7 @@ library
     , transformers
     , typed-protocols
     , unliftio
+    , unliftio-core
 
   hs-source-dirs:   src
   default-language: Haskell2010
diff --git a/...rc/Cardano/Wallet/Shelley/Network/Node.hs → .../Cardano/Wallet/Network/Implementation.hs b/...rc/Cardano/Wallet/Shelley/Network/Node.hs → .../Cardano/Wallet/Network/Implementation.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -21,7 +22,7 @@
 -- - Module's documentation in `ouroboros-network/typed-protocols/src/Network/TypedProtocols.hs`
 -- - Data Diffusion and Peer Networking in Shelley (see: https://raw.githubusercontent.com/wiki/cardano-foundation/cardano-wallet/data_diffusion_and_peer_networking_in_shelley.pdf)
 --     - In particular sections 4.1, 4.2, 4.6 and 4.8
-module Cardano.Wallet.Shelley.Network.Node
+module Cardano.Wallet.Network.Implementation
     ( withNetworkLayer
     , NetworkParams(..)
     , Observer (query, startObserving, stopObserving)
@@ -59,14 +60,7 @@ import Cardano.Launcher.Node
     ( CardanoNodeConn
     , nodeSocketFile
     )
-import Cardano.Pool.Types
-    ( PoolId
-    , StakePoolsSummary (..)
-    )
-import Cardano.Wallet.Byron.Compatibility
-    ( byronCodecConfig
-    , protocolParametersFromUpdateState
-    )
+
 import Cardano.Wallet.Network
     ( ChainFollowLog (..)
     , ChainFollower
@@ -77,28 +71,29 @@ import Cardano.Wallet.Network
     , mapChainSyncLog
     , withFollowStatsMonitoring
     )
-import Cardano.Wallet.Primitive.Ledger.Read.Block.Header
-    ( getBlockHeader
-    )
-import Cardano.Wallet.Primitive.Slotting
-    ( TimeInterpreter
-    , TimeInterpreterLog
-    , currentRelativeTime
-    , mkTimeInterpreter
+import Cardano.Wallet.Network.Implementation.Ouroboros
+    ( LSQ (..)
+    , LocalStateQueryCmd (..)
+    , LocalTxSubmissionCmd (..)
+    , PipeliningStrategy
+    , chainSyncFollowTip
+    , chainSyncWithBlocks
+    , localStateQuery
+    , localTxSubmission
+    , send
     )
-import Cardano.Wallet.Primitive.SyncProgress
-    ( SyncProgress (..)
-    , SyncTolerance
+import Cardano.Wallet.Network.Implementation.UnliftIO
+    ( coerceHandlers
     )
-import Cardano.Wallet.Primitive.Types
-    ( GenesisParameters (..)
+import Cardano.Wallet.Primitive.Ledger.Byron
+    ( byronCodecConfig
+    , protocolParametersFromUpdateState
     )
-import Cardano.Wallet.Primitive.Types.Tx
-    ( SealedTx (..)
+import Cardano.Wallet.Primitive.Ledger.Read.Block.Header
+    ( getBlockHeader
     )
-import Cardano.Wallet.Shelley.Compatibility
-    ( StandardCrypto
-    , fromAllegraPParams
+import Cardano.Wallet.Primitive.Ledger.Shelley
+    ( fromAllegraPParams
     , fromAlonzoPParams
     , fromBabbagePParams
     , fromConwayPParams
@@ -119,6 +114,43 @@ import Cardano.Wallet.Shelley.Compatibility
     , toShelleyCoin
     , unsealShelleyTx
     )
+import Cardano.Wallet.Primitive.Slotting
+    ( TimeInterpreter
+    , TimeInterpreterLog
+    , currentRelativeTime
+    , mkTimeInterpreter
+    )
+import Cardano.Wallet.Primitive.SyncProgress
+    ( SyncProgress (..)
+    , SyncTolerance
+    )
+import Cardano.Wallet.Primitive.Types.Block
+    ( BlockHeader
+    )
+import Cardano.Wallet.Primitive.Types.EraInfo
+    ( EraInfo (..)
+    )
+import Cardano.Wallet.Primitive.Types.GenesisParameters
+    ( GenesisParameters (..)
+    )
+import Cardano.Wallet.Primitive.Types.NetworkParameters
+    ( NetworkParameters (..)
+    )
+import Cardano.Wallet.Primitive.Types.Pool
+    ( PoolId
+    )
+import Cardano.Wallet.Primitive.Types.ProtocolParameters
+    ( ProtocolParameters
+    )
+import Cardano.Wallet.Primitive.Types.SlottingParameters
+    ( SlottingParameters
+    )
+import Cardano.Wallet.Primitive.Types.StakePoolSummary
+    ( StakePoolsSummary (..)
+    )
+import Cardano.Wallet.Primitive.Types.Tx
+    ( SealedTx (..)
+    )
 import Control.Applicative
     ( liftA3
     )
@@ -310,6 +342,7 @@ import Ouroboros.Consensus.Protocol.TPraos
     )
 import Ouroboros.Consensus.Shelley.Eras
     ( StandardConway
+    , StandardCrypto
     )
 import Ouroboros.Consensus.Shelley.Ledger.Config
     ( CodecConfig (..)
@@ -319,17 +352,6 @@ import Ouroboros.Network.Block
     ( Point
     , Tip (..)
     )
-import Ouroboros.Network.Client.Wallet
-    ( LSQ (..)
-    , LocalStateQueryCmd (..)
-    , LocalTxSubmissionCmd (..)
-    , PipeliningStrategy
-    , chainSyncFollowTip
-    , chainSyncWithBlocks
-    , localStateQuery
-    , localTxSubmission
-    , send
-    )
 import Ouroboros.Network.Driver.Simple
     ( TraceSendRecv
     , runPeer
@@ -384,9 +406,6 @@ import UnliftIO.Async
     ( async
     , link
     )
-import UnliftIO.Compat
-    ( coerceHandlers
-    )
 import UnliftIO.Concurrent
     ( ThreadId
     )
@@ -402,7 +421,6 @@ import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Cardano.Ledger.Shelley.LedgerState as SL
 import qualified Cardano.Wallet.Primitive.Ledger.Convert as Ledger
 import qualified Cardano.Wallet.Primitive.SyncProgress as SP
-import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Cardano.Wallet.Primitive.Types.Coin as W
 import qualified Cardano.Wallet.Primitive.Types.RewardAccount as W
 import qualified Cardano.Wallet.Primitive.Types.Tx as W
@@ -425,7 +443,7 @@ withNetworkLayer
     -- ^ Logging of network layer startup
     -> PipeliningStrategy (CardanoBlock StandardCrypto)
     -- ^ pipelining value by the block heigh
-    -> W.NetworkParameters
+    -> NetworkParameters
     -- ^ Initial blockchain parameters
     -> CardanoNodeConn
     -- ^ Socket for communicating with the node
@@ -449,16 +467,16 @@ withNetworkLayer tr pipeliningStrategy np conn ver tol action = do
 -- | Network parameters and protocol parameters for the node's current tip.
 data NetworkParams = NetworkParams
     { protocolParams :: MaybeInRecentEra Write.PParams
-    , protocolParamsLegacy :: W.ProtocolParameters
-    , slottingParamsLegacy :: W.SlottingParameters
+    , protocolParamsLegacy :: ProtocolParameters
+    , slottingParamsLegacy :: SlottingParameters
     }
     deriving (Eq, Show)
 
 withNodeNetworkLayerBase
     :: HasCallStack
     => Tracer IO Log
     -> PipeliningStrategy (CardanoBlock StandardCrypto)
-    -> W.NetworkParameters
+    -> NetworkParameters
     -> CardanoNodeConn
     -> NodeToClientVersionData
     -> SyncTolerance
@@ -545,11 +563,11 @@ withNodeNetworkLayerBase
                 , syncProgress = _syncProgress interpreterVar
                 }
       where
-        gp@W.GenesisParameters
+        gp@GenesisParameters
             { getGenesisBlockHash
             , getGenesisBlockDate
-            } = W.genesisParameters np
-        sp = W.slottingParameters np
+            } = genesisParameters np
+        sp = slottingParameters np
         cfg = codecConfig sp
 
         connectNodeClient
@@ -837,7 +855,7 @@ mkWalletToNodeProtocols
      . (HasCallStack, MonadUnliftIO m, MonadThrow m, MonadST m, MonadTimer m)
     => Tracer m Log
     -- ^ Base trace for underlying protocols
-    -> W.NetworkParameters
+    -> NetworkParameters
     -- ^ Initial blockchain parameters
     -> ( NetworkParams -> m ())
     -- ^ Notifier callback for when parameters for tip change.
@@ -876,7 +894,7 @@ mkWalletToNodeProtocols
 
         let queryParams = do
                 eraBounds <-
-                    W.EraInfo
+                    EraInfo
                         <$> LSQry (QueryAnytimeByron GetEraStart)
                         <*> LSQry (QueryAnytimeShelley GetEraStart)
                         <*> LSQry (QueryAnytimeAllegra GetEraStart)
@@ -886,7 +904,7 @@ mkWalletToNodeProtocols
 
                 sp <-
                     byronOrShelleyBased
-                        (pure $ W.slottingParameters np)
+                        (pure $ slottingParameters np)
                         ( (slottingParametersFromGenesis . getCompactGenesis)
                             <$> LSQry Shelley.GetGenesisConfig
                         )
@@ -929,7 +947,7 @@ mkWalletToNodeProtocols
 
         let queryInterpreter = LSQry (QueryHardFork GetInterpreter)
 
-        let cfg = codecConfig (W.slottingParameters np)
+        let cfg = codecConfig (slottingParameters np)
 
         -- NOTE: These are updated every block. This is far more often than
         -- necessary.
@@ -1138,7 +1156,7 @@ codecVersion version = verMap ! version
   where
     verMap = supportedNodeToClientVersions (Proxy @(CardanoBlock StandardCrypto))
 
-codecConfig :: W.SlottingParameters -> CodecConfig (CardanoBlock c)
+codecConfig :: SlottingParameters -> CodecConfig (CardanoBlock c)
 codecConfig sp =
     CardanoCodecConfig
         (byronCodecConfig sp)
@@ -1414,8 +1432,8 @@ data Log where
            )
         -> Log
     MsgPostTx :: W.SealedTx -> Log
-    MsgNodeTip :: W.BlockHeader -> Log
-    MsgProtocolParameters :: W.ProtocolParameters -> W.SlottingParameters -> Log
+    MsgNodeTip :: BlockHeader -> Log
+    MsgProtocolParameters :: ProtocolParameters -> SlottingParameters -> Log
     MsgLocalStateQueryError :: QueryClientName -> String -> Log
     MsgLocalStateQueryEraMismatch
         :: MismatchEraInfo (CardanoEras StandardCrypto) -> Log
@@ -1436,7 +1454,7 @@ data Log where
         -> Log
         -- ^ Number of pools in stake distribution, and rewards map,
         -- respectively.
-    MsgWatcherUpdate :: W.BlockHeader -> BracketLog -> Log
+    MsgWatcherUpdate :: BlockHeader -> BracketLog -> Log
     MsgInterpreter :: CardanoInterpreter StandardCrypto -> Log
     -- TODO: Combine ^^ and vv
     MsgInterpreterLog :: TimeInterpreterLog -> Log

diff --git a/...et/src/Ouroboros/Network/Client/Wallet.hs → ...allet/Network/Implementation/Ouroboros.hs b/...et/src/Ouroboros/Network/Client/Wallet.hs → ...allet/Network/Implementation/Ouroboros.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -21,7 +22,7 @@
 -- clients implement the logic and lift away concerns related to concrete
 -- data-type representation so that the code can be re-used / shared between
 -- Byron and Shelley.
-module Ouroboros.Network.Client.Wallet
+module Cardano.Wallet.Network.Implementation.Ouroboros
     (
       -- * ChainSyncFollowTip
       chainSyncFollowTip

diff --git a/lib/network-layer/src/Cardano/Wallet/Network/Implementation/UnliftIO.hs b/lib/network-layer/src/Cardano/Wallet/Network/Implementation/UnliftIO.hs
@@ -0,0 +1,20 @@
+module Cardano.Wallet.Network.Implementation.UnliftIO
+    ( coerceHandler
+    , coerceHandlers
+    )
+where
+
+import qualified Control.Monad.Catch as Exceptions
+import qualified UnliftIO
+
+-- | Convert the generalized handler from 'UnliftIO.Exception' type to 'Control.Monad.Catch' type
+coerceHandler :: UnliftIO.Handler IO b -> Exceptions.Handler IO b
+coerceHandler (UnliftIO.Handler h) = Exceptions.Handler h
+
+-- | Convert a list of handler factories from the 'UnliftIO.Exception' type to
+-- 'Control.Monad.Catch' type. Such handlers are used in
+-- 'Control.Retry.Recovering' for example.
+coerceHandlers
+    :: [a -> UnliftIO.Handler IO b]
+    -> [a -> Exceptions.Handler IO b]
+coerceHandlers = map (coerceHandler .)