<commit_before>{-# LANGUAGE ViewPatterns #-}
-- | High level workers.

module Pos.Worker
       ( runWorkers
       , statsWorkers
       ) where

import           Control.TimeWarp.Logging (logDebug, logInfo, logNotice)
import           Control.TimeWarp.Timed   (fork_)
import           Data.Tagged              (untag)
import           Formatting               (build, sformat, (%))
import           Universum

import           Pos.Communication        (SysStartResponse (..))
import           Pos.Constants            (sysTimeBroadcastSlots)
import           Pos.DHT                  (sendToNetwork)
import           Pos.Slotting             (onNewSlot)
import           Pos.Ssc.Class.Workers    (SscWorkersClass, sscOnNewSlot, sscWorkers)
import           Pos.State                (processNewSlot)
import           Pos.Types                (SlotId, flattenSlotId, slotIdF)
import           Pos.Util                 (logWarningWaitLinear)
import           Pos.Util.JsonLog         (jlCreatedBlock, jlLog)
import           Pos.Worker.Block         (blkOnNewSlot, blkWorkers)
import           Pos.Worker.Stats         (statsWorkers)
import           Pos.Worker.Tx            (txWorkers)
import           Pos.WorkMode             (NodeContext (..), WorkMode, getNodeContext)

-- | Run all necessary workers in separate threads. This call doesn't
-- block.
runWorkers :: (SscWorkersClass ssc,  WorkMode ssc m) => m ()
runWorkers = mapM_ fork_ $ concat
    [ [onNewSlotWorker]
    , blkWorkers
    , untag sscWorkers
    , txWorkers
    ]

onNewSlotWorker :: (SscWorkersClass ssc, WorkMode ssc m) => m ()
onNewSlotWorker = onNewSlot True onNewSlotWorkerImpl

onNewSlotWorkerImpl :: (SscWorkersClass ssc, WorkMode ssc m)
                    => SlotId -> m ()
onNewSlotWorkerImpl slotId = do
    logNotice $ sformat ("New slot has just started: "%slotIdF) slotId
    -- A note about order: currently only one thing is important, that
    -- `processNewSlot` is executed before everything else
    mGenBlock <- processNewSlot slotId
    forM_ mGenBlock $ \createdBlk -> do
      logInfo $ sformat ("Created genesis block:\n" %build) createdBlk
      jlLog $ jlCreatedBlock (Left createdBlk)
    logDebug "Finished `processNewSlot`"

    when (flattenSlotId slotId <= sysTimeBroadcastSlots) $
      whenM (ncTimeLord <$> getNodeContext) $
        ncSystemStart <$> getNodeContext
            >>= \(SysStartResponse . Just -> mT) -> do
                logInfo "Broadcasting system start"
                sendToNetwork mT

    fork_ $ do
        logWarningWaitLinear 8 "mpcOnNewSlot" $ untag sscOnNewSlot slotId
        logDebug "Finished `mpcOnNewSlot`"
    blkOnNewSlot slotId
    logDebug "Finished `blkOnNewSlot`"<commit_msg>[CSL-120] Do not print warning when mpcOnNewSlot takes more than 8 sec<commit_after>{-# LANGUAGE ViewPatterns #-}
-- | High level workers.

module Pos.Worker
       ( runWorkers
       , statsWorkers
       ) where

import           Control.TimeWarp.Logging (logDebug, logInfo, logNotice)
import           Control.TimeWarp.Timed   (fork_)
import           Data.Tagged              (untag)
import           Formatting               (build, sformat, (%))
import           Universum

import           Pos.Communication        (SysStartResponse (..))
import           Pos.Constants            (sysTimeBroadcastSlots)
import           Pos.DHT                  (sendToNetwork)
import           Pos.Slotting             (onNewSlot)
import           Pos.Ssc.Class.Workers    (SscWorkersClass, sscOnNewSlot, sscWorkers)
import           Pos.State                (processNewSlot)
import           Pos.Types                (SlotId, flattenSlotId, slotIdF)
import           Pos.Util.JsonLog         (jlCreatedBlock, jlLog)
import           Pos.Worker.Block         (blkOnNewSlot, blkWorkers)
import           Pos.Worker.Stats         (statsWorkers)
import           Pos.Worker.Tx            (txWorkers)
import           Pos.WorkMode             (NodeContext (..), WorkMode, getNodeContext)

-- | Run all necessary workers in separate threads. This call doesn't
-- block.
runWorkers :: (SscWorkersClass ssc,  WorkMode ssc m) => m ()
runWorkers = mapM_ fork_ $ concat
    [ [onNewSlotWorker]
    , blkWorkers
    , untag sscWorkers
    , txWorkers
    ]

onNewSlotWorker :: (SscWorkersClass ssc, WorkMode ssc m) => m ()
onNewSlotWorker = onNewSlot True onNewSlotWorkerImpl

onNewSlotWorkerImpl :: (SscWorkersClass ssc, WorkMode ssc m)
                    => SlotId -> m ()
onNewSlotWorkerImpl slotId = do
    logNotice $ sformat ("New slot has just started: "%slotIdF) slotId
    -- A note about order: currently only one thing is important, that
    -- `processNewSlot` is executed before everything else
    mGenBlock <- processNewSlot slotId
    forM_ mGenBlock $ \createdBlk -> do
      logInfo $ sformat ("Created genesis block:\n" %build) createdBlk
      jlLog $ jlCreatedBlock (Left createdBlk)
    logDebug "Finished `processNewSlot`"

    when (flattenSlotId slotId <= sysTimeBroadcastSlots) $
      whenM (ncTimeLord <$> getNodeContext) $
        ncSystemStart <$> getNodeContext
            >>= \(SysStartResponse . Just -> mT) -> do
                logInfo "Broadcasting system start"
                sendToNetwork mT

    fork_ (untag sscOnNewSlot slotId)
    blkOnNewSlot slotId
    logDebug "Finished `blkOnNewSlot`"
{'fraction_non_alphanumeric': 0.08167853128512552, 'fraction_numerical': 0.0009366804046459348, 'mean_word_length': 2.1970059880239523, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '761188', 'n_tokens_mistral': 1586, 'n_tokens_neox': 1540, 'n_words': 412}