<commit_before>-- | Block processing related workers.

module Pos.Worker.Block
       ( blkOnNewSlot
       , blkWorkers
       ) where

import           Control.Lens              (ix, (^.), (^?))
import           Control.TimeWarp.Logging  (logInfo, logWarning)
import           Control.TimeWarp.Timed    (Microsecond, for, repeatForever, sec, wait)
import           Formatting                (build, sformat, (%))
import           Serokell.Util.Exceptions  ()
import           Universum

import           Pos.Communication.Methods (announceBlock)
import           Pos.Constants             (networkDiameter, slotDuration)
import           Pos.State                 (createNewBlock, getHeadBlock, getLeaders)
import           Pos.Types                 (SlotId (..), gbHeader, gbHeader, slotIdF)
import           Pos.WorkMode              (WorkMode, getNodeContext, ncPublicKey,
                                            ncSecretKey)

-- | Action which should be done when new slot starts.
blkOnNewSlot :: WorkMode m => SlotId -> m ()
blkOnNewSlot slotId@SlotId {..} = do
    leaders <- getLeaders siEpoch
    ourPk <- ncPublicKey <$> getNodeContext
    let leader = leaders ^? ix (fromIntegral siSlot)
    when (leader == Just ourPk) $ onNewSlotWhenLeader slotId

onNewSlotWhenLeader :: WorkMode m => SlotId -> m ()
onNewSlotWhenLeader slotId = do
    logInfo $
        sformat ("I am leader of "%slotIdF%", I will create block soon") slotId
    wait $ for (slotDuration - networkDiameter)
    logInfo "It's time to create a block for current slot"
    sk <- ncSecretKey <$> getNodeContext
    createdBlk <- createNewBlock sk slotId
    logInfo $ sformat ("Created a new block: "%build) createdBlk
    announceBlock $ createdBlk ^. gbHeader

-- | All workers specific to block processing.
-- Exceptions:
-- 1. Worker which ticks when new slot starts.
blkWorkers :: WorkMode m => [m ()]
blkWorkers = [blocksTransmitter]

blocksTransmitterInterval :: Microsecond
blocksTransmitterInterval = sec 3

blocksTransmitter :: WorkMode m => m ()
blocksTransmitter =
    repeatForever blocksTransmitterInterval onError $
    do headBlock <- getHeadBlock
       case headBlock of
           Left _ -> logWarning "Head block is genesis block ⇒ no announcement"
           Right mainBlock -> announceBlock (mainBlock ^. gbHeader)
  where
    onError e =
        blocksTransmitterInterval <$
        logWarning (sformat ("Error occured in blocksTransmitter: " %build) e)
<commit_msg>Fix unreasonable logging severity<commit_after>-- | Block processing related workers.

module Pos.Worker.Block
       ( blkOnNewSlot
       , blkWorkers
       ) where

import           Control.Lens              (ix, (^.), (^?))
import           Control.TimeWarp.Logging  (logDebug, logInfo, logWarning)
import           Control.TimeWarp.Timed    (Microsecond, for, repeatForever, sec, wait)
import           Formatting                (build, sformat, (%))
import           Serokell.Util.Exceptions  ()
import           Universum

import           Pos.Communication.Methods (announceBlock)
import           Pos.Constants             (networkDiameter, slotDuration)
import           Pos.State                 (createNewBlock, getHeadBlock, getLeaders)
import           Pos.Types                 (SlotId (..), gbHeader, gbHeader, slotIdF)
import           Pos.WorkMode              (WorkMode, getNodeContext, ncPublicKey,
                                            ncSecretKey)

-- | Action which should be done when new slot starts.
blkOnNewSlot :: WorkMode m => SlotId -> m ()
blkOnNewSlot slotId@SlotId {..} = do
    leaders <- getLeaders siEpoch
    ourPk <- ncPublicKey <$> getNodeContext
    let leader = leaders ^? ix (fromIntegral siSlot)
    when (leader == Just ourPk) $ onNewSlotWhenLeader slotId

onNewSlotWhenLeader :: WorkMode m => SlotId -> m ()
onNewSlotWhenLeader slotId = do
    logInfo $
        sformat ("I am leader of "%slotIdF%", I will create block soon") slotId
    wait $ for (slotDuration - networkDiameter)
    logInfo "It's time to create a block for current slot"
    sk <- ncSecretKey <$> getNodeContext
    createdBlk <- createNewBlock sk slotId
    logInfo $ sformat ("Created a new block: "%build) createdBlk
    announceBlock $ createdBlk ^. gbHeader

-- | All workers specific to block processing.
-- Exceptions:
-- 1. Worker which ticks when new slot starts.
blkWorkers :: WorkMode m => [m ()]
blkWorkers = [blocksTransmitter]

blocksTransmitterInterval :: Microsecond
blocksTransmitterInterval = sec 3

blocksTransmitter :: WorkMode m => m ()
blocksTransmitter =
    repeatForever blocksTransmitterInterval onError $
    do headBlock <- getHeadBlock
       case headBlock of
           Left _          -> logDebug "Head block is genesis block ⇒ no announcement"
           Right mainBlock -> announceBlock (mainBlock ^. gbHeader)
  where
    onError e =
        blocksTransmitterInterval <$
        logWarning (sformat ("Error occured in blocksTransmitter: " %build) e)

{'fraction_non_alphanumeric': 0.08579465541490858, 'fraction_numerical': 0.0008036970062286518, 'mean_word_length': 2.5056338028169014, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 23, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5074881', 'n_tokens_mistral': 1421, 'n_tokens_neox': 1375, 'n_words': 426}