enable getting node's ProtocolParameters

cardano-foundation · Sep 28, 2021 · e918b8a · e918b8a
1 parent aea6d3b
commit e918b8a
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 6 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Network.hs b/lib/core/src/Cardano/Wallet/Network.hs
@@ -105,6 +105,7 @@ import UnliftIO.Concurrent
 import UnliftIO.Exception
     ( SomeException, bracket, handle )
 
+import qualified Cardano.Api.Shelley as Node
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
 
@@ -150,6 +151,11 @@ data NetworkLayer m block = NetworkLayer
         -- ^ Get the last known protocol parameters. In principle, these can
         -- only change once per epoch.
 
+    , currentNodeProtocolParameters
+        :: m Node.ProtocolParameters
+        -- ^ Get the last known node's protocol parameters. In principle, these can
+        -- only change once per epoch.
+
     , currentSlottingParameters
         :: m SlottingParameters
         -- ^ Get the last known slotting parameters. In principle, these can

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network.hs
@@ -265,6 +265,7 @@ import UnliftIO.Exception
     ( Handler (..), IOException )
 
 import qualified Cardano.Api as Cardano
+import qualified Cardano.Api.Shelley as Cardano
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
 import qualified Cardano.Ledger.Crypto as SL
@@ -361,7 +362,9 @@ withNetworkLayerBase tr net np conn versionData tol action = do
         , cursorSlotNo =
             _cursorSlotNo
         , currentProtocolParameters =
-            fst <$> atomically (readTMVar networkParamsVar)
+            fst . fst <$> atomically (readTMVar networkParamsVar)
+        , currentNodeProtocolParameters =
+            snd . fst <$> atomically (readTMVar networkParamsVar)
         , currentSlottingParameters =
             snd <$> atomically (readTMVar networkParamsVar)
         , postTx =
@@ -395,7 +398,7 @@ withNetworkLayerBase tr net np conn versionData tol action = do
         :: HasCallStack
         => RetryHandlers
         -> IO ( STM IO (Tip (CardanoBlock StandardCrypto))
-              , TMVar IO (W.ProtocolParameters, W.SlottingParameters)
+              , TMVar IO ((W.ProtocolParameters, Cardano.ProtocolParameters), W.SlottingParameters)
               , TMVar IO (CardanoInterpreter StandardCrypto)
               , TMVar IO AnyCardanoEra
               )
@@ -724,7 +727,7 @@ mkTipSyncClient
         -- ^ Base trace for underlying protocols
     -> W.NetworkParameters
         -- ^ Initial blockchain parameters
-    -> (W.ProtocolParameters -> W.SlottingParameters -> m ())
+    -> ((W.ProtocolParameters, Cardano.ProtocolParameters) -> W.SlottingParameters -> m ())
         -- ^ Notifier callback for when parameters for tip change.
     -> (CardanoInterpreter StandardCrypto -> m ())
         -- ^ Notifier callback for when time interpreter is updated.
@@ -737,9 +740,9 @@ mkTipSyncClient tr np onPParamsUpdate onInterpreterUpdate onEraUpdate = do
 
     tipVar <- newTVarIO (Just $ AnyCardanoEra ByronEra, TipGenesis)
 
-    (onPParamsUpdate' :: (W.ProtocolParameters, W.SlottingParameters) -> m ()) <-
+    (onPParamsUpdate' :: ((W.ProtocolParameters, Cardano.ProtocolParameters), W.SlottingParameters) -> m ()) <-
         debounce $ \(pp, sp) -> do
-            traceWith tr $ MsgProtocolParameters pp sp
+            traceWith tr $ MsgProtocolParameters (fst pp) sp
             onPParamsUpdate pp sp
 
     let queryParams = do
@@ -766,7 +769,19 @@ mkTipSyncClient tr np onPParamsUpdate onInterpreterUpdate onEraUpdate = do
                     <$> LSQry Shelley.GetCurrentPParams)
                 (fromAlonzoPParams eraBounds
                     <$> LSQry Shelley.GetCurrentPParams)
-            return (pp, sp)
+
+            ppNode <- onAnyEra
+                (error "not sure at this moment how to handle that")
+                (Cardano.fromLedgerPParams Cardano.ShelleyBasedEraShelley
+                    <$> LSQry Shelley.GetCurrentPParams)
+                (Cardano.fromLedgerPParams Cardano.ShelleyBasedEraAllegra
+                    <$> LSQry Shelley.GetCurrentPParams)
+                (Cardano.fromLedgerPParams Cardano.ShelleyBasedEraMary
+                    <$> LSQry Shelley.GetCurrentPParams)
+                (Cardano.fromLedgerPParams Cardano.ShelleyBasedEraAlonzo
+                    <$> LSQry Shelley.GetCurrentPParams)
+
+            return ((pp, ppNode), sp)
 
     let queryInterpreter = LSQry (QueryHardFork GetInterpreter)