<commit_before>{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Logic of Explorer socket-io Server.

module Pos.Explorer.Socket.Methods
       ( Subscription (..)
       , ClientEvent (..)
       , ServerEvent (..)

       , startSession
       , finishSession
       , subscribeAddr
       , subscribeBlocks
       , subscribeBlocksLastPage
       , subscribeBlocksOff
       , subscribeTxs
       , unsubscribeAddr
       , unsubscribeBlocks
       , unsubscribeBlocksLastPage
       , unsubscribeBlocksOff
       , unsubscribeTxs

       , notifyAddrSubscribers
       , notifyBlocksSubscribers
       , notifyBlocksLastPageSubscribers
       , notifyBlocksOffSubscribers
       , notifyTxsSubscribers
       , getBlocksFromTo
       , addrsTouchedByTx
       , getBlockTxs
       , getTxInfo
       ) where

import           Control.Lens                   (at, ix, lens, non, (.=), _Just)
import           Control.Monad.State            (MonadState)
import           Data.Aeson                     (ToJSON)
import qualified Data.Map                       as M
import qualified Data.Set                       as S
import           Formatting                     (sformat, shown, stext, (%))
import           Network.EngineIO               (SocketId)
import           Network.SocketIO               (Socket, socketId)
import           Pos.Block.Core                 (Block, mainBlockTxPayload)
import qualified Pos.Block.Logic                as DB
import           Pos.Crypto                     (withHash)
import           Pos.Crypto                     (hash)
import qualified Pos.DB.Block                   as DB
import           Pos.DB.Class                   (MonadDBRead)
import qualified Pos.DB.GState                  as DB
import           Pos.Explorer                   (TxExtra (..))
import qualified Pos.Explorer                   as DB
import           Pos.Ssc.GodTossing             (SscGodTossing)
import           Pos.Txp                        (Tx (..), TxOut (..), TxOutAux (..),
                                                 txOutAddress, txpTxs)
import           Pos.Types                      (Address, HeaderHash)
import           Pos.Util                       (maybeThrow)
import           Pos.Util.Chrono                (getOldestFirst)
import           System.Wlog                    (WithLogger, logDebug, logWarning,
                                                 modifyLoggerName)
import           Universum

import           Pos.Explorer.Aeson.ClientTypes ()
import           Pos.Explorer.Socket.Holder     (ClientContext, ConnectionsState,
                                                 ccAddress, ccBlockOff, ccConnection,
                                                 csAddressSubscribers,
                                                 csBlocksOffSubscribers,
                                                 csBlocksPageSubscribers,
                                                 csBlocksSubscribers, csClients,
                                                 csTxsSubscribers, mkClientContext)
import           Pos.Explorer.Socket.Util       (EventName (..), emitTo)
import           Pos.Explorer.Web.ClientTypes   (CAddress, CTxBrief, CTxEntry (..),
                                                 TxInternal (..), fromCAddress,
                                                 toBlockEntry, toTxBrief)
import           Pos.Explorer.Web.Error         (ExplorerError (..))
import           Pos.Explorer.Web.Server        (ExplorerMode, getBlocksLastPage,
                                                 getLastBlocks, topsortTxsOrFail)

-- * Event names

data Subscription
    = SubAddr
    | SubBlock
    | SubBlockLastPage  -- ^ subscribe on blocks last page (newest blocks)
    | SubBlockOff       -- ^ subscribe on blocks with given offset
    | SubTx
    deriving (Show, Generic)

data ClientEvent
    = Subscribe Subscription
    | Unsubscribe Subscription
    | CallMe
    | CallMeString
    | CallMeTxId
    deriving (Show, Generic)

instance EventName ClientEvent where
    toName = show

data ServerEvent
    = AddrUpdated
    | BlocksUpdated
    | BlocksLastPageUpdated
    | BlocksOffUpdated
    | TxsUpdated
    -- TODO: test events, remove one day
    | CallYou
    | CallYouString
    | CallYouTxId
    deriving (Show, Generic)

instance EventName ServerEvent where
    toName = show

-- * Util

fromCAddressOrThrow :: MonadThrow m => CAddress -> m Address
fromCAddressOrThrow =
    either (\_ -> throwM $ Internal "Malformed address") return .
    fromCAddress

-- * Client requests provessing

type SubscriptionMode m =
    ( WithLogger m
    , MonadThrow m
    , MonadState ConnectionsState m
    )

-- | This describes points related to some subscribtion action.
-- Each subscription type has its own /client data/ which user provides
-- as parameter when subscribes, it is then stored in 'ClientContext' type.
data SubscriptionParam cli = SubscriptionParam
    { -- | Identificator of current session
      spSessId       :: SocketId
      -- | Description of this subscription
    , spDesc         :: cli -> Text
      -- | Sets current session subscribed / unsubscribed
    , spSubscription :: cli -> Lens' ConnectionsState (Maybe ())
      -- | Sets related client data present / absent
    , spCliData      :: Lens' ClientContext (Maybe cli)
    }

startSession
    :: SubscriptionMode m
    => Socket -> m ()
startSession conn = do
    let cc = mkClientContext conn
        id = socketId conn
    csClients . at id .= Just cc
    logDebug $ sformat ("New session has started (#"%shown%")") id

finishSession
    :: SubscriptionMode m
    => SocketId -> m ()
finishSession sessId =
    whenJustM (use $ csClients . at sessId) $ \_ -> do
        csClients . at sessId .= Nothing
        unsubscribeFully sessId
        logDebug $ sformat ("Session #"%shown%" has finished") sessId

subscribe
    :: SubscriptionMode m
    => cli -> SubscriptionParam cli -> m ()
subscribe cliData sp@SubscriptionParam{..} = do
    unsubscribe sp
    session <- use $ csClients . at spSessId
    case session of
        Just _  -> do
            spSubscription cliData .= Just ()
            csClients . ix spSessId . spCliData .= Just cliData
            logDebug $ sformat ("Client #"%shown%" subscribed to "%stext%" \
                       \updates") spSessId (spDesc cliData)
        _       ->
            logWarning $ sformat ("Unregistered client tries to subscribe on "%<commit_msg>[CSE-146] Fix subscriptions leaking<commit_after>{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Logic of Explorer socket-io Server.

module Pos.Explorer.Socket.Methods
       ( Subscription (..)
       , ClientEvent (..)
       , ServerEvent (..)

       , startSession
       , finishSession
       , subscribeAddr
       , subscribeBlocks
       , subscribeBlocksLastPage
       , subscribeBlocksOff
       , subscribeTxs
       , unsubscribeAddr
       , unsubscribeBlocks
       , unsubscribeBlocksLastPage
       , unsubscribeBlocksOff
       , unsubscribeTxs

       , notifyAddrSubscribers
       , notifyBlocksSubscribers
       , notifyBlocksLastPageSubscribers
       , notifyBlocksOffSubscribers
       , notifyTxsSubscribers
       , getBlocksFromTo
       , addrsTouchedByTx
       , getBlockTxs
       , getTxInfo
       ) where

import           Control.Lens                   (at, ix, lens, non, (.=), _Just)
import           Control.Monad.State            (MonadState)
import           Data.Aeson                     (ToJSON)
import qualified Data.Map                       as M
import qualified Data.Set                       as S
import           Formatting                     (sformat, shown, stext, (%))
import           Network.EngineIO               (SocketId)
import           Network.SocketIO               (Socket, socketId)
import           Pos.Block.Core                 (Block, mainBlockTxPayload)
import qualified Pos.Block.Logic                as DB
import           Pos.Crypto                     (withHash)
import           Pos.Crypto                     (hash)
import qualified Pos.DB.Block                   as DB
import           Pos.DB.Class                   (MonadDBRead)
import qualified Pos.DB.GState                  as DB
import           Pos.Explorer                   (TxExtra (..))
import qualified Pos.Explorer                   as DB
import           Pos.Ssc.GodTossing             (SscGodTossing)
import           Pos.Txp                        (Tx (..), TxOut (..), TxOutAux (..),
                                                 txOutAddress, txpTxs)
import           Pos.Types                      (Address, HeaderHash)
import           Pos.Util                       (maybeThrow)
import           Pos.Util.Chrono                (getOldestFirst)
import           System.Wlog                    (WithLogger, logDebug, logWarning,
                                                 modifyLoggerName)
import           Universum

import           Pos.Explorer.Aeson.ClientTypes ()
import           Pos.Explorer.Socket.Holder     (ClientContext, ConnectionsState,
                                                 ccAddress, ccBlockOff, ccConnection,
                                                 csAddressSubscribers,
                                                 csBlocksOffSubscribers,
                                                 csBlocksPageSubscribers,
                                                 csBlocksSubscribers, csClients,
                                                 csTxsSubscribers, mkClientContext)
import           Pos.Explorer.Socket.Util       (EventName (..), emitTo)
import           Pos.Explorer.Web.ClientTypes   (CAddress, CTxBrief, CTxEntry (..),
                                                 TxInternal (..), fromCAddress,
                                                 toBlockEntry, toTxBrief)
import           Pos.Explorer.Web.Error         (ExplorerError (..))
import           Pos.Explorer.Web.Server        (ExplorerMode, getBlocksLastPage,
                                                 getLastBlocks, topsortTxsOrFail)

-- * Event names

data Subscription
    = SubAddr
    | SubBlock
    | SubBlockLastPage  -- ^ subscribe on blocks last page (newest blocks)
    | SubBlockOff       -- ^ subscribe on blocks with given offset
    | SubTx
    deriving (Show, Generic)

data ClientEvent
    = Subscribe Subscription
    | Unsubscribe Subscription
    | CallMe
    | CallMeString
    | CallMeTxId
    deriving (Show, Generic)

instance EventName ClientEvent where
    toName = show

data ServerEvent
    = AddrUpdated
    | BlocksUpdated
    | BlocksLastPageUpdated
    | BlocksOffUpdated
    | TxsUpdated
    -- TODO: test events, remove one day
    | CallYou
    | CallYouString
    | CallYouTxId
    deriving (Show, Generic)

instance EventName ServerEvent where
    toName = show

-- * Util

fromCAddressOrThrow :: MonadThrow m => CAddress -> m Address
fromCAddressOrThrow =
    either (\_ -> throwM $ Internal "Malformed address") return .
    fromCAddress

-- * Client requests provessing

type SubscriptionMode m =
    ( WithLogger m
    , MonadThrow m
    , MonadState ConnectionsState m
    )

-- | This describes points related to some subscribtion action.
-- Each subscription type has its own /client data/ which user provides
-- as parameter when subscribes, it is then stored in 'ClientContext' type.
data SubscriptionParam cli = SubscriptionParam
    { -- | Identificator of current session
      spSessId       :: SocketId
      -- | Description of this subscription
    , spDesc         :: cli -> Text
      -- | Sets current session subscribed / unsubscribed
    , spSubscription :: cli -> Lens' ConnectionsState (Maybe ())
      -- | Sets related client data present / absent
    , spCliData      :: Lens' ClientContext (Maybe cli)
    }

startSession
    :: SubscriptionMode m
    => Socket -> m ()
startSession conn = do
    let cc = mkClientContext conn
        id = socketId conn
    csClients . at id .= Just cc
    logDebug $ sformat ("New session has started (#"%shown%")") id

finishSession
    :: SubscriptionMode m
    => SocketId -> m ()
finishSession sessId =
    whenJustM (use $ csClients . at sessId) $ \_ -> do
        unsubscribeFully sessId
        csClients . at sessId .= Nothing
        logDebug $ sformat ("Session #"%shown%" has finished") sessId

subscribe
    :: SubscriptionMode m
    => cli -> SubscriptionParam cli -> m ()
subscribe cliData sp@SubscriptionParam{..} = do
    unsubscribe sp
    session <- use $ csClients . at spSessId
    case session of
        Just _  -> do
            spSubscription cliData .= Just ()
            csClients . ix spSessId . spCliData .= Just cliData
            logDebug $ sformat ("Client #"%shown%" subscribed to "%stext%" \
                       \updates") spSessId (spDesc cliData)
        _       ->
            logWarning $ sformat ("Unregistered client tries to subscribe on "%
{'fraction_non_alphanumeric': 0.07295182571340902, 'fraction_numerical': 0.00023013194231359313, 'mean_word_length': 1.5658334973430428, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 33, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 44, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '954348', 'n_tokens_mistral': 3361, 'n_tokens_neox': 3234, 'n_words': 893}