<commit_before>{-# LANGUAGE ScopedTypeVariables #-}
-- | Announcements related to blocks.

module Pos.Block.Network.Announce
       ( announceBlock
       , announceBlockOuts
       , handleHeadersCommunication
       ) where

import           Universum

import           Data.Reflection            (Reifies)
import qualified Ether
import           Formatting                 (build, sformat, (%))
import           Mockable                   (throw)
import           System.Wlog                (logDebug)

import           Pos.Binary.Communication   ()
import           Pos.Block.Logic            (getHeadersFromManyTo)
import           Pos.Block.Network.Types    (MsgGetHeaders (..), MsgHeaders (..))
import           Pos.Communication.Limits   (Limit, LimitedLength, recvLimited,
                                             reifyMsgLimit)
import           Pos.Communication.Message  ()
import           Pos.Communication.Protocol (ConversationActions (..), NodeId (..),
                                             OutSpecs, SendActions (..), convH,
                                             toOutSpecs)
import           Pos.Context                (NodeParams, npAttackTypes,
                                             recoveryInProgress)
import           Pos.Crypto                 (shortHashF)
import qualified Pos.DB.Block               as DB
import qualified Pos.DB.DB                  as DB
import           Pos.Discovery              (converseToNeighbors)
import           Pos.Security               (AttackType (..), NodeAttackedError (..),
                                             shouldIgnoreAddress)
import           Pos.Types                  (MainBlockHeader, headerHash)
import           Pos.Util.TimeWarp          (nodeIdToAddress)
import           Pos.WorkMode.Class         (WorkMode)

announceBlockOuts :: OutSpecs
announceBlockOuts = toOutSpecs [convH (Proxy :: Proxy (MsgHeaders ssc))
                                      (Proxy :: Proxy MsgGetHeaders)
                               ]

announceBlock
    :: WorkMode ssc m
    => SendActions m -> MainBlockHeader ssc -> m ()
announceBlock sendActions header = do
    logDebug $ sformat ("Announcing header to others:\n"%build) header
    nodeParams <- Ether.ask @NodeParams
    let throwOnIgnored (NodeId (_, nId)) =
            whenJust (nodeIdToAddress nId) $ \addr ->
                when (shouldIgnoreAddress nodeParams addr) $
                throw AttackNoBlocksTriggered
        sendActions' =
            if AttackNoBlocks `elem` npAttackTypes nodeParams
                then sendActions
                     { sendTo =
                           \nId msg -> do
                               throwOnIgnored nId
                               sendTo sendActions nId msg
                     , withConnectionTo =
                           \nId handler -> do
                               throwOnIgnored nId
                               withConnectionTo sendActions nId handler
                     }
                else sendActions
    reifyMsgLimit (Proxy @MsgGetHeaders) $ \limitProxy -> do
        converseToNeighbors sendActions' $ announceBlockDo limitProxy
  where
    announceBlockDo limitProxy nodeId conv = do
        logDebug $
            sformat
                ("Announcing block "%shortHashF%" to "%build)
                (headerHash header)
                nodeId
        send conv $ MsgHeaders (one (Right header))
        handleHeadersCommunication conv limitProxy

handleHeadersCommunication
    :: forall ssc m s.
       (WorkMode ssc m, Reifies s (Limit MsgGetHeaders))
    => ConversationActions (MsgHeaders ssc) (LimitedLength s MsgGetHeaders) m
    -> Proxy s
    -> m ()
handleHeadersCommunication conv _ = do
    whenJustM (recvLimited conv) $ \mgh@(MsgGetHeaders {..}) -> do
        logDebug $ sformat ("Got request on handleGetHeaders: "%build) mgh
        ifM recoveryInProgress onRecovery $ do
            headers <- case (mghFrom,mghTo) of
                ([], Nothing) -> Right . one <$> DB.getTipBlockHeader @ssc
                ([], Just h)  ->
                    maybeToRight "getBlockHeader returned Nothing" . fmap one <$>
                    DB.getBlockHeader @ssc h
                (c1:cxs, _)   -> getHeadersFromManyTo (c1:|cxs) mghTo
            either onNoHeaders handleSuccess headers
  where
    handleSuccess h = do
        onSuccess
        send conv (MsgHeaders h)
        handleHeadersCommunication conv Proxy
    onSuccess =
        logDebug "handleGetHeaders: responded successfully"
    onRecovery =
        logDebug "handleGetHeaders: not responding, we're in recovery mode"
    onNoHeaders reason =
        logDebug $ "getheadersFromManyTo returned Nothing, " <>
                   "not replying to node, reason: " <> reason<commit_msg>[CSL-1139] Return last main block on GetHeaders [] request<commit_after>{-# LANGUAGE ScopedTypeVariables #-}
-- | Announcements related to blocks.

module Pos.Block.Network.Announce
       ( announceBlock
       , announceBlockOuts
       , handleHeadersCommunication
       ) where

import           Universum

import           Data.Reflection            (Reifies)
import qualified Ether
import           Formatting                 (build, sformat, (%))
import           Mockable                   (throw)
import           System.Wlog                (logDebug)

import           Pos.Binary.Communication   ()
import           Pos.Block.Logic            (getHeadersFromManyTo)
import           Pos.Block.Network.Types    (MsgGetHeaders (..), MsgHeaders (..))
import           Pos.Communication.Limits   (Limit, LimitedLength, recvLimited,
                                             reifyMsgLimit)
import           Pos.Communication.Message  ()
import           Pos.Communication.Protocol (ConversationActions (..), NodeId (..),
                                             OutSpecs, SendActions (..), convH,
                                             toOutSpecs)
import           Pos.Context                (NodeParams, npAttackTypes,
                                             recoveryInProgress)
import           Pos.Crypto                 (shortHashF)
import qualified Pos.DB.Block               as DB
import qualified Pos.DB.DB                  as DB
import           Pos.Discovery              (converseToNeighbors)
import           Pos.Security               (AttackType (..), NodeAttackedError (..),
                                             shouldIgnoreAddress)
import           Pos.Types                  (Block, BlockHeader, MainBlockHeader,
                                             blockHeader, headerHash, prevBlockL)
import           Pos.Util.TimeWarp          (nodeIdToAddress)
import           Pos.WorkMode.Class         (WorkMode)

announceBlockOuts :: OutSpecs
announceBlockOuts = toOutSpecs [convH (Proxy :: Proxy (MsgHeaders ssc))
                                      (Proxy :: Proxy MsgGetHeaders)
                               ]

announceBlock
    :: WorkMode ssc m
    => SendActions m -> MainBlockHeader ssc -> m ()
announceBlock sendActions header = do
    logDebug $ sformat ("Announcing header to others:\n"%build) header
    nodeParams <- Ether.ask @NodeParams
    let throwOnIgnored (NodeId (_, nId)) =
            whenJust (nodeIdToAddress nId) $ \addr ->
                when (shouldIgnoreAddress nodeParams addr) $
                throw AttackNoBlocksTriggered
        sendActions' =
            if AttackNoBlocks `elem` npAttackTypes nodeParams
                then sendActions
                     { sendTo =
                           \nId msg -> do
                               throwOnIgnored nId
                               sendTo sendActions nId msg
                     , withConnectionTo =
                           \nId handler -> do
                               throwOnIgnored nId
                               withConnectionTo sendActions nId handler
                     }
                else sendActions
    reifyMsgLimit (Proxy @MsgGetHeaders) $ \limitProxy -> do
        converseToNeighbors sendActions' $ announceBlockDo limitProxy
  where
    announceBlockDo limitProxy nodeId conv = do
        logDebug $
            sformat
                ("Announcing block "%shortHashF%" to "%build)
                (headerHash header)
                nodeId
        send conv $ MsgHeaders (one (Right header))
        handleHeadersCommunication conv limitProxy

handleHeadersCommunication
    :: forall ssc m s.
       (WorkMode ssc m, Reifies s (Limit MsgGetHeaders))
    => ConversationActions (MsgHeaders ssc) (LimitedLength s MsgGetHeaders) m
    -> Proxy s
    -> m ()
handleHeadersCommunication conv _ = do
    whenJustM (recvLimited conv) $ \mgh@(MsgGetHeaders {..}) -> do
        logDebug $ sformat ("Got request on handleGetHeaders: "%build) mgh
        ifM recoveryInProgress onRecovery $ do
            headers <- case (mghFrom,mghTo) of
                ([], Nothing) -> Right . one <$> getLastMainBlock
                ([], Just h)  ->
                    maybeToRight "getBlockHeader returned Nothing" . fmap one <$>
                    DB.getBlockHeader @ssc h
                (c1:cxs, _)   -> getHeadersFromManyTo (c1:|cxs) mghTo
            either onNoHeaders handleSuccess headers
  where
    -- retrieves last main block if there's any
    getLastMainBlock :: m (BlockHeader ssc)
    getLastMainBlock = do
        (tip :: Block ssc) <- DB.getTipBlock @ssc
        let tipHash = tip ^. blockHeader
        case tip of
            Left _  -> fromMaybe tipHash <$> DB.getBlockHeader (tip ^. prevBlockL)
            Right _ -> pure tipHash
    handleSuccess h = do
        onSuccess
        send conv (MsgHeaders h)
        handleHeadersCommunication conv Proxy
    onSuccess =
        logDebug "handleGetHeaders: responded successfully"
    onRecovery =
        logDebug "handleGetHeaders: not responding, we're in recovery mode"
    onNoHeaders reason =
        logDebug $ "getheadersFromManyTo returned Nothing, " <>
                   "not replying to node, reason: " <> reason
{'fraction_non_alphanumeric': 0.07051792828685259, 'fraction_numerical': 0.0007968127490039841, 'mean_word_length': 1.5471841704718416, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 42, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 24, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6519619', 'n_tokens_mistral': 2506, 'n_tokens_neox': 2414, 'n_words': 669}