Merge pull request #3495 from input-output-hk/adinapoli/feature/cbr-246-hook-sync-progress-to-info-api

[CBR-246] Implement getInfo with the new data layer

Author: adinapoli-iohk

wallet-new/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs

@@ -23,6 +23,7 @@ module Cardano.Wallet.Kernel.NodeStateAdaptor (
   , getSlotCount
   , getSlotStart
   , getNextEpochSlotDuration
+  , getNodeSyncProgress
   , curSoftwareVersion
   , compileInfo
   , getNtpDrift
@@ -42,10 +43,10 @@ module Cardano.Wallet.Kernel.NodeStateAdaptor (
 
 import           Universum
 
-import           Control.Lens (lens)
+import           Control.Lens (lens, to)
 import           Control.Monad.IO.Unlift (MonadUnliftIO, UnliftIO (UnliftIO),
                      askUnliftIO, unliftIO, withUnliftIO)
-import           Control.Monad.STM (retry)
+import           Control.Monad.STM (orElse, retry)
 import           Data.Conduit (mapOutputMaybe, runConduitRes, (.|))
 import qualified Data.Conduit.List as Conduit
 import           Data.SafeCopy (base, deriveSafeCopy)
@@ -57,14 +58,16 @@ import           Ntp.Packet (NtpOffset)
 import           Serokell.Data.Memory.Units (Byte)
 
 import qualified Cardano.Wallet.API.V1.Types as V1
-import           Pos.Chain.Block (Block, HeaderHash, MainBlock, blockHeader,
-                     headerHash, mainBlockSlot, prevBlockL)
+import           Pos.Chain.Block (Block, HeaderHash, LastKnownHeader,
+                     LastKnownHeaderTag, MainBlock, blockHeader, headerHash,
+                     mainBlockSlot, prevBlockL)
 import           Pos.Chain.Update (ConfirmedProposalState,
                      HasUpdateConfiguration, SoftwareVersion, bvdMaxTxSize)
 import qualified Pos.Chain.Update as Upd
 import           Pos.Context (NodeContext (..))
-import           Pos.Core (ProtocolConstants (pcK), SlotCount, Timestamp,
-                     genesisBlockVersionData, pcEpochSlots)
+import           Pos.Core (BlockCount, ProtocolConstants (pcK), SlotCount,
+                     Timestamp, difficultyL, genesisBlockVersionData,
+                     getChainDifficulty, pcEpochSlots)
 import           Pos.Core.Configuration (HasConfiguration, genesisHash,
                      protocolConstants)
 import           Pos.Core.Slotting (EpochIndex (..), HasSlottingVar (..),
@@ -257,6 +260,18 @@ data NodeStateAdaptor m = Adaptor {
       -- | Get last known slot duration.
     , getNextEpochSlotDuration :: m Millisecond
 
+      -- | Get the "sync progress". This term is desperately overloaded but
+      -- in this context we need something very simple: a tuple containing the
+      -- "global blockchain height" and the "node blockchain height". The
+      -- former is the maximum between the biggest height we observed from an
+      -- unsolicited block we received and the current local tip:
+      --
+      -- global_height = max (last_known_header, node_local_tip)
+      --
+      -- The latter is simply the node local tip, i.e. "how far we went into
+      -- chasing the global blockchain height during syncing".
+    , getNodeSyncProgress :: LockContext -> m (Maybe BlockCount, BlockCount)
+
       -- | Version of application (code running)
     , curSoftwareVersion :: m SoftwareVersion
 
@@ -265,6 +280,7 @@ data NodeStateAdaptor m = Adaptor {
 
       -- | Ask the NTP client for the status
     , getNtpDrift :: V1.ForceNtpCheck -> m V1.TimeInfo
+
     }
 
 {-------------------------------------------------------------------------------
@@ -298,6 +314,9 @@ instance HasLens S.SimpleSlottingStateVar Res S.SimpleSlottingStateVar where
 instance HasLens UpdateContext Res UpdateContext where
     lensOf = mkResLens (nrContextLens . lensOf')
 
+instance HasLens LastKnownHeaderTag Res LastKnownHeader where
+    lensOf = mkResLens (nrContextLens . lensOf @LastKnownHeaderTag)
+
 instance HasSlottingVar Res where
     slottingTimestamp = mkResLens (nrContextLens . slottingTimestamp)
     slottingVar       = mkResLens (nrContextLens . slottingVar)
@@ -346,11 +365,12 @@ newNodeStateAdaptor :: forall m ext. (NodeConstraints, MonadIO m, MonadMask m)
                     -> TVar NtpStatus
                     -> NodeStateAdaptor m
 newNodeStateAdaptor nr ntpStatus = Adaptor {
-      withNodeState            =            run
-    , getTipSlotId             =            run $ \_lock -> defaultGetTipSlotId
-    , getMaxTxSize             =            run $ \_lock -> defaultGetMaxTxSize
-    , getSlotStart             = \slotId -> run $ \_lock -> defaultGetSlotStart slotId
-    , getNextEpochSlotDuration =            run $ \_lock -> defaultGetNextEpochSlotDuration
+      withNodeState            =             run
+    , getTipSlotId             =             run $ \_lock -> defaultGetTipSlotId
+    , getMaxTxSize             =             run $ \_lock -> defaultGetMaxTxSize
+    , getSlotStart             = \slotId  -> run $ \_lock -> defaultGetSlotStart slotId
+    , getNextEpochSlotDuration =             run $ \_lock -> defaultGetNextEpochSlotDuration
+    , getNodeSyncProgress      = \lockCtx -> run $ defaultSyncProgress lockCtx
     , getSecurityParameter     = return $ pcK'         protocolConstants
     , getSlotCount             = return $ pcEpochSlots protocolConstants
     , curSoftwareVersion       = return $ Upd.curSoftwareVersion
@@ -405,6 +425,23 @@ defaultGetSlotStart slotId =
 defaultGetNextEpochSlotDuration :: MonadIO m => WithNodeState m Millisecond
 defaultGetNextEpochSlotDuration = Slotting.getNextEpochSlotDuration
 
+defaultSyncProgress :: (MonadIO m, MonadMask m, NodeConstraints)
+                    => LockContext
+                    -> Lock (WithNodeState m)
+                    -> WithNodeState m (Maybe BlockCount, BlockCount)
+defaultSyncProgress lockContext lock = do
+    (globalHeight, localHeight) <- lock lockContext $ \_localTipHash -> do
+        -- We need to grab the localTip again as '_localTip' has type
+        -- 'HeaderHash' but we cannot grab the difficulty out of it.
+        headerRef <- view (lensOf @LastKnownHeaderTag)
+        localTip  <- getTipHeader
+        mbHeader <- atomically $ readTVar headerRef `orElse` pure Nothing
+        pure (view (difficultyL . to getChainDifficulty) <$> mbHeader
+             ,view (difficultyL . to getChainDifficulty) localTip
+             )
+    return (max localHeight <$> globalHeight, localHeight)
+
+
 {-------------------------------------------------------------------------------
   Non-mockable functions
 -------------------------------------------------------------------------------}
@@ -511,6 +548,7 @@ mockNodeState MockNodeStateParams{..} =
         , getTipSlotId             = return mockNodeStateTipSlotId
         , getSecurityParameter     = return mockNodeStateSecurityParameter
         , getNextEpochSlotDuration = return mockNodeStateNextEpochSlotDuration
+        , getNodeSyncProgress      = \_ -> return mockNodeStateSyncProgress
         , getSlotStart             = return . mockNodeStateSlotStart
         , getMaxTxSize             = return $ bvdMaxTxSize genesisBlockVersionData
         , getSlotCount             = return $ pcEpochSlots protocolConstants
@@ -540,6 +578,9 @@ data MockNodeStateParams = NodeConstraints => MockNodeStateParams {
         -- | Value for 'getNextEpochSlotDuration'
       , mockNodeStateNextEpochSlotDuration :: Millisecond
 
+        -- | Value for 'getNodeSyncProgress'
+      , mockNodeStateSyncProgress :: (Maybe BlockCount, BlockCount)
+
         -- | Value for 'getNtpDrift'
       , mockNodeStateNtpDrift :: V1.ForceNtpCheck -> V1.TimeInfo
       }
@@ -563,6 +604,7 @@ defMockNodeStateParams =
           mockNodeStateTipSlotId             = notDefined "mockNodeStateTipSlotId"
         , mockNodeStateSlotStart             = notDefined "mockNodeStateSlotStart"
         , mockNodeStateNextEpochSlotDuration = notDefined "mockNodeStateNextEpochSlotDuration"
+        , mockNodeStateSyncProgress          = notDefined "mockNodeStateSyncProgress"
         , mockNodeStateSecurityParameter     = SecurityParameter 2160
         , mockNodeStateNtpDrift              = const (V1.TimeInfo Nothing)
         }

wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Info.hs

@@ -4,18 +4,21 @@ module Cardano.Wallet.WalletLayer.Kernel.Info (
 
 import           Universum
 
+import qualified Pos.Core as Core
+
 import qualified Cardano.Wallet.API.V1.Types as V1
 import           Cardano.Wallet.Kernel.Diffusion (walletGetSubscriptionStatus)
 import qualified Cardano.Wallet.Kernel.Internal as Kernel
 import           Cardano.Wallet.Kernel.NodeStateAdaptor (NodeStateAdaptor)
 import qualified Cardano.Wallet.Kernel.NodeStateAdaptor as Node
 
 getNodeInfo :: MonadIO m => Kernel.ActiveWallet -> V1.ForceNtpCheck -> m V1.NodeInfo
-getNodeInfo aw ntpCheckBehavior = liftIO $
+getNodeInfo aw ntpCheckBehavior = liftIO $ do
+    (mbNodeHeight, localHeight) <- Node.getNodeSyncProgress node Node.NotYetLocked
     V1.NodeInfo
-      <$> (pure $ V1.mkSyncPercentage 100) -- TODO (Restoration [CBR-243])
-      <*> (pure $ Nothing)                 -- TODO (Restoration [CBR-243])
-      <*> (pure $ V1.mkBlockchainHeight 0) -- TODO (Restoration [CBR-243])
+      <$> (pure $ v1SyncPercentage mbNodeHeight localHeight)
+      <*> (pure $ V1.mkBlockchainHeight <$> mbNodeHeight)
+      <*> (pure $ V1.mkBlockchainHeight localHeight)
       <*> (Node.getNtpDrift node ntpCheckBehavior)
       <*> (walletGetSubscriptionStatus (Kernel.walletDiffusion aw))
   where
@@ -24,3 +27,12 @@ getNodeInfo aw ntpCheckBehavior = liftIO $
 
     pw :: Kernel.PassiveWallet
     pw = Kernel.walletPassive aw
+
+-- | Computes the V1 'SyncPercentage' out of the global & local blockchain heights.
+v1SyncPercentage :: Maybe Core.BlockCount -> Core.BlockCount -> V1.SyncPercentage
+v1SyncPercentage nodeHeight walletHeight =
+    let percentage = case nodeHeight of
+            Nothing -> 0
+            Just nd | walletHeight >= nd -> 100 :: Int
+            Just nd -> floor @Double $ (fromIntegral walletHeight / max 1.0 (fromIntegral nd)) * 100.0
+    in V1.mkSyncPercentage (fromIntegral percentage)

wallet-new/test/unit/Test/Spec/TxMetaScenarios.hs

@@ -393,6 +393,7 @@ nodeStParams1 =
       , mockNodeStateSecurityParameter = SecurityParameter 2160
       , mockNodeStateNextEpochSlotDuration = fromMicroseconds 200
       , mockNodeStateNtpDrift = const (V1.TimeInfo Nothing)
+      , mockNodeStateSyncProgress = (Just 100, 100)
       }
 
 nodeStParams2 :: MockNodeStateParams
@@ -406,6 +407,7 @@ nodeStParams2 =
       , mockNodeStateSecurityParameter = SecurityParameter 2160
       , mockNodeStateNextEpochSlotDuration = fromMicroseconds 200
       , mockNodeStateNtpDrift = const (V1.TimeInfo Nothing)
+      , mockNodeStateSyncProgress = (Just 100, 100)
       }
 
 -- | Initialize active wallet in a manner suitable for generator-based testing.