<commit_before>{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE Rank2Types           #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- | This module defines methods which operate on GtLocalData.

module Pos.Ssc.GodTossing.LocalData.LocalData
       (
         localOnNewSlot
       , sscIsDataUseful
       , sscProcessMessage
         -- * Instances
         -- ** instance SscLocalDataClass SscGodTossing
       ) where

import           Control.Lens                         (Getter, at, use, uses, view, views,
                                                       (%=), (.=))
import           Data.Containers                      (ContainerKey,
                                                       SetContainer (notMember))
import qualified Data.HashMap.Strict                  as HM
import qualified Data.HashSet                         as HS
import qualified Data.List.NonEmpty                   as NE
import           Serokell.Util.Verify                 (isVerSuccess)
import           Universum

import           Pos.Binary.Class                     (Bi)
import           Pos.Crypto                           (Share)
import           Pos.Lrc.Types                        (Richmen)
import           Pos.Ssc.Class.LocalData              (LocalQuery, LocalUpdate,
                                                       SscLocalDataClass (..))
import           Pos.Ssc.Extra.MonadLD                (MonadSscLD)
import           Pos.Ssc.GodTossing.Functions         (checkCommShares,
                                                       checkOpeningMatchesCommitment,
                                                       checkShares, isCommitmentIdx,
                                                       isOpeningIdx, isSharesIdx,
                                                       verifySignedCommitment)
import           Pos.Ssc.GodTossing.LocalData.Helpers (GtState, gtGlobalCertificates,
                                                       gtGlobalCommitments,
                                                       gtGlobalOpenings, gtGlobalShares,
                                                       gtLastProcessedSlot,
                                                       gtLocalCertificates,
                                                       gtLocalCommitments,
                                                       gtLocalOpenings, gtLocalShares,
                                                       gtRunModify, gtRunRead)
import           Pos.Ssc.GodTossing.LocalData.Types   (ldCertificates, ldCommitments,
                                                       ldOpenings, ldShares)
import           Pos.Ssc.GodTossing.Types             (GtGlobalState (..), GtPayload (..),
                                                       SscBi, SscGodTossing)
import           Pos.Ssc.GodTossing.Types.Base        (Commitment, Opening,
                                                       SignedCommitment, VssCertificate,
                                                       VssCertificatesMap, vcVssKey)
import           Pos.Ssc.GodTossing.Types.Message     (GtMsgContents (..), GtMsgTag (..))
import qualified Pos.Ssc.GodTossing.VssCertData       as VCD
import           Pos.Types                            (SlotId (..), StakeholderId)
import           Pos.Util                             (AsBinary, diffDoubleMap, getKeys,
                                                       readerToState)

instance SscBi => SscLocalDataClass SscGodTossing where
    sscGetLocalPayloadQ = getLocalPayload
    sscApplyGlobalStateU = applyGlobal

type LDQuery a = forall m .  MonadReader GtState m => m a
type LDUpdate a = forall m . MonadState GtState m  => m a

----------------------------------------------------------------------------
-- Apply Global State
----------------------------------------------------------------------------
applyGlobal :: Richmen -> GtGlobalState -> LocalUpdate SscGodTossing ()
applyGlobal (HS.fromList . NE.toList -> richmen) globalData = do
    localCerts <- uses ldCertificates VCD.certs
    let globalCerts = VCD.certs . _gsVssCertificates $ globalData
        participants = HS.toMap $ (getKeys $ localCerts `HM.union` globalCerts)
                                   `HS.intersection` richmen
        globalCommitments = _gsCommitments globalData
        globalOpenings = _gsOpenings globalData
        globalShares = _gsShares globalData
    -- 1. remove commitments which are contained already in global state
    -- 2. remove commitments which corresponds to expired certs
    ldCommitments  %= (`HM.difference` globalCommitments) . (`HM.difference` participants)
    -- 1. remove openings which are contained already in global state
    -- 2. remove openings corresponding to invalid commitments
    ldOpenings  %= (`HM.difference` globalOpenings) . (`HM.difference` globalCommitments)
    ldShares  %= (`diffDoubleMap` globalShares) . (`HM.difference` globalCommitments)
    ldCertificates  %= (`VCD.difference` globalCerts)

----------------------------------------------------------------------------
-- Get Local Payload
----------------------------------------------------------------------------
getLocalPayload :: SlotId -> LocalQuery SscGodTossing GtPayload
getLocalPayload SlotId{..} =
    (if isCommitmentIdx siSlot then
        CommitmentsPayload <$> view ldCommitments
    else if isOpeningIdx siSlot then
        OpeningsPayload <$> view ldOpenings
    else if isSharesIdx siSlot then<commit_msg>[CSL-538] Filter local data properly<commit_after>{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE Rank2Types           #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- | This module defines methods which operate on GtLocalData.

module Pos.Ssc.GodTossing.LocalData.LocalData
       (
         localOnNewSlot
       , sscIsDataUseful
       , sscProcessMessage
         -- * Instances
         -- ** instance SscLocalDataClass SscGodTossing
       ) where

import           Control.Lens                         (Getter, at, use, uses, view, views,
                                                       (%=), (.=))
import           Data.Containers                      (ContainerKey,
                                                       SetContainer (notMember))
import qualified Data.HashMap.Strict                  as HM
import qualified Data.HashSet                         as HS
import qualified Data.List.NonEmpty                   as NE
import           Serokell.Util.Verify                 (isVerSuccess)
import           Universum

import           Pos.Binary.Class                     (Bi)
import           Pos.Crypto                           (Share)
import           Pos.Lrc.Types                        (Richmen)
import           Pos.Ssc.Class.LocalData              (LocalQuery, LocalUpdate,
                                                       SscLocalDataClass (..))
import           Pos.Ssc.Extra.MonadLD                (MonadSscLD)
import           Pos.Ssc.GodTossing.Functions         (checkCommShares,
                                                       checkOpeningMatchesCommitment,
                                                       checkShare, checkShares,
                                                       isCommitmentIdx, isOpeningIdx,
                                                       isSharesIdx,
                                                       verifySignedCommitment)
import           Pos.Ssc.GodTossing.LocalData.Helpers (GtState, gtGlobalCertificates,
                                                       gtGlobalCommitments,
                                                       gtGlobalOpenings, gtGlobalShares,
                                                       gtLastProcessedSlot,
                                                       gtLocalCertificates,
                                                       gtLocalCommitments,
                                                       gtLocalOpenings, gtLocalShares,
                                                       gtRunModify, gtRunRead)
import           Pos.Ssc.GodTossing.LocalData.Types   (ldCertificates, ldCommitments,
                                                       ldOpenings, ldShares)
import           Pos.Ssc.GodTossing.Types             (GtGlobalState (..), GtPayload (..),
                                                       SscBi, SscGodTossing)
import           Pos.Ssc.GodTossing.Types.Base        (Commitment, Opening,
                                                       SignedCommitment, VssCertificate,
                                                       VssCertificatesMap, vcVssKey)
import           Pos.Ssc.GodTossing.Types.Message     (GtMsgContents (..), GtMsgTag (..))
import qualified Pos.Ssc.GodTossing.VssCertData       as VCD
import           Pos.Types                            (SlotId (..), StakeholderId)
import           Pos.Util                             (AsBinary, diffDoubleMap, getKeys,
                                                       readerToState)

instance SscBi => SscLocalDataClass SscGodTossing where
    sscGetLocalPayloadQ = getLocalPayload
    sscApplyGlobalStateU = applyGlobal

type LDQuery a = forall m .  MonadReader GtState m => m a
type LDUpdate a = forall m . MonadState GtState m  => m a

----------------------------------------------------------------------------
-- Apply Global State
----------------------------------------------------------------------------
applyGlobal :: Richmen -> GtGlobalState -> LocalUpdate SscGodTossing ()
applyGlobal (HS.fromList . NE.toList -> richmen) globalData = do
    localCerts <- uses ldCertificates VCD.certs
    let globalCerts = VCD.certs . _gsVssCertificates $ globalData
        participants = HS.toMap $ (getKeys $ localCerts `HM.union` globalCerts)
                                   `HS.intersection` richmen
        globalCommitments = _gsCommitments globalData
        globalOpenings = _gsOpenings globalData
        globalShares = _gsShares globalData
    -- 1. remove commitments which are contained already in global state
    -- 2. remove commitments which corresponds to expired certs
    ldCommitments  %= (`HM.difference` globalCommitments) . (`HM.intersection` participants)
    let filterOpenings opens =
            foldl' (flip ($)) opens $
            [
            -- Select only new openings
              (`HM.difference` globalOpenings)
            -- Select commitments which sent opening
            , (`HM.intersection` globalCommitments)
            -- Select opening which corresponds its commitment
            , HM.filterWithKey
                  (curry $ checkOpeningMatchesCommitment globalCommitments)
            ]
    let checkCorrectShares pkTo shares = HM.filterWithKey
            (\pkFrom share ->
                 checkShare
                     globalCommitments
                     globalOpenings
                     globalCerts
                     (pkTo, pkFrom, share)) shares
    let filterShares shares =
            foldl' (flip ($)) shares $
            [
            -- Select only new shares
              (`diffDoubleMap` globalShares)
            -- Select shares from nodes which sent certificates
            , (`HM.intersection` globalCerts)
            -- Select shares to nodes which sent commitments
            , map (`HM.intersection` globalCerts)
            -- Ensure that share sent from pkFrom to pkTo is valid
            , HM.mapWithKey checkCorrectShares
            ]
    ldOpenings  %= filterOpenings
    ldShares  %= filterShares
    ldCertificates  %= (`VCD.difference` globalCerts)

----------------------------------------------------------------------------
-- Get Local Payload
----------------------------------------------------------------------------
getLocalPayload :: SlotId -> LocalQuery SscGodTossing GtPayload
getLocalPayload SlotId{..} =
    (if isCommitmentIdx siSlot then
        CommitmentsPayload <$> view ldCommitments
    else if isOpeningIdx siSlot then
        OpeningsPayload <$> view ldOpenings
    else if isSharesIdx siSlot then
{'fraction_non_alphanumeric': 0.10962261068452867, 'fraction_numerical': 0.0008985459892174481, 'mean_word_length': 1.1669026548672565, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 22, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 80, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1206539', 'n_tokens_mistral': 2827, 'n_tokens_neox': 2732, 'n_words': 654}