{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Metro.Node
  ( NodeEnv
  , NodeMode (..)
  , SessionMode (..)
  , NodeT
  , initEnv
  , withEnv

  , setNodeMode
  , setSessionMode
  , setDefaultSessionTimeout
  , setDefaultSessionTimeout1

  , runNodeT
  , startNodeT
  , startNodeT_
  , withSessionT
  , nodeState
  , stopNodeT
  , env
  , request
  , requestAndRetry

  , newSessionEnv
  , nextSessionId
  , runSessionT_

  , busy

  -- combine node env and conn env
  , NodeEnv1 (..)
  , initEnv1
  , runNodeT1
  , getEnv1

  , getTimer
  , getNodeId

  , getSessionSize
  , getSessionSize1
  ) where

import           Control.Monad              (forM, forever, void, when)
import           Control.Monad.Cont         (callCC, runContT)
import           Control.Monad.Reader.Class (MonadReader (ask), asks)
import           Control.Monad.Trans.Class  (MonadTrans (..))
import           Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
import           Data.Hashable
import           Data.IOHashMap             (IOHashMap)
import qualified Data.IOHashMap             as HM (delete, elems, empty, insert,
                                                   lookup, size)
import           Data.Int                   (Int64)
import           Data.Maybe                 (fromMaybe, isJust)
import           Metro.Class                (GetPacketId, RecvPacket,
                                             SendPacket, SetPacketId, Transport,
                                             getPacketId)
import           Metro.Conn                 (ConnEnv, ConnT, FromConn (..),
                                             close, receive, runConnT)
import           Metro.Session              (SessionEnv (sessionId), SessionT,
                                             feed, isTimeout, runSessionT)
import qualified Metro.Session              as S (newSessionEnv, receive, send)
import           Metro.Utils                (getEpochTime)
import           System.Log.Logger          (errorM)
import           UnliftIO
import           UnliftIO.Concurrent        (threadDelay)

data NodeMode = Single
    | Multi
    deriving (Int -> NodeMode -> ShowS
[NodeMode] -> ShowS
NodeMode -> String
(Int -> NodeMode -> ShowS)
-> (NodeMode -> String) -> ([NodeMode] -> ShowS) -> Show NodeMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeMode] -> ShowS
$cshowList :: [NodeMode] -> ShowS
show :: NodeMode -> String
$cshow :: NodeMode -> String
showsPrec :: Int -> NodeMode -> ShowS
$cshowsPrec :: Int -> NodeMode -> ShowS
Show, NodeMode -> NodeMode -> Bool
(NodeMode -> NodeMode -> Bool)
-> (NodeMode -> NodeMode -> Bool) -> Eq NodeMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeMode -> NodeMode -> Bool
$c/= :: NodeMode -> NodeMode -> Bool
== :: NodeMode -> NodeMode -> Bool
$c== :: NodeMode -> NodeMode -> Bool
Eq)

data SessionMode = SingleAction
    | MultiAction
    deriving (Int -> SessionMode -> ShowS
[SessionMode] -> ShowS
SessionMode -> String
(Int -> SessionMode -> ShowS)
-> (SessionMode -> String)
-> ([SessionMode] -> ShowS)
-> Show SessionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionMode] -> ShowS
$cshowList :: [SessionMode] -> ShowS
show :: SessionMode -> String
$cshow :: SessionMode -> String
showsPrec :: Int -> SessionMode -> ShowS
$cshowsPrec :: Int -> SessionMode -> ShowS
Show, SessionMode -> SessionMode -> Bool
(SessionMode -> SessionMode -> Bool)
-> (SessionMode -> SessionMode -> Bool) -> Eq SessionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionMode -> SessionMode -> Bool
$c/= :: SessionMode -> SessionMode -> Bool
== :: SessionMode -> SessionMode -> Bool
$c== :: SessionMode -> SessionMode -> Bool
Eq)


data NodeEnv u nid k rpkt = NodeEnv
    { NodeEnv u nid k rpkt -> u
uEnv        :: u
    , NodeEnv u nid k rpkt -> TVar Bool
nodeStatus  :: TVar Bool
    , NodeEnv u nid k rpkt -> NodeMode
nodeMode    :: NodeMode
    , NodeEnv u nid k rpkt -> SessionMode
sessionMode :: SessionMode
    , NodeEnv u nid k rpkt -> TVar (Maybe (SessionEnv u nid k rpkt))
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
    , NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
    , NodeEnv u nid k rpkt -> IO k
sessionGen  :: IO k
    , NodeEnv u nid k rpkt -> TVar Int64
nodeTimer   :: TVar Int64
    , NodeEnv u nid k rpkt -> nid
nodeId      :: nid
    , NodeEnv u nid k rpkt -> TVar Int64
sessTimeout :: TVar Int64
    , NodeEnv u nid k rpkt -> TVar (Maybe (u -> IO ()))
onNodeLeave :: TVar (Maybe (u -> IO ()))
    }

data NodeEnv1 u nid k rpkt tp = NodeEnv1
    { NodeEnv1 u nid k rpkt tp -> NodeEnv u nid k rpkt
nodeEnv :: NodeEnv u nid k rpkt
    , NodeEnv1 u nid k rpkt tp -> ConnEnv tp
connEnv :: ConnEnv tp
    }

newtype NodeT u nid k rpkt tp m a = NodeT { NodeT u nid k rpkt tp m a
-> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
unNodeT :: ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a }
  deriving
    ( a -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
(a -> b) -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
(forall a b.
 (a -> b) -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b)
-> (forall a b.
    a -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a)
-> Functor (NodeT u nid k rpkt tp m)
forall a b.
a -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
forall a b.
(a -> b) -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a b.
Functor m =>
a -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a b.
Functor m =>
(a -> b) -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
$c<$ :: forall u nid k rpkt tp (m :: * -> *) a b.
Functor m =>
a -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
fmap :: (a -> b) -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
$cfmap :: forall u nid k rpkt tp (m :: * -> *) a b.
Functor m =>
(a -> b) -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
Functor
    , Functor (NodeT u nid k rpkt tp m)
a -> NodeT u nid k rpkt tp m a
Functor (NodeT u nid k rpkt tp m)
-> (forall a. a -> NodeT u nid k rpkt tp m a)
-> (forall a b.
    NodeT u nid k rpkt tp m (a -> b)
    -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b)
-> (forall a b c.
    (a -> b -> c)
    -> NodeT u nid k rpkt tp m a
    -> NodeT u nid k rpkt tp m b
    -> NodeT u nid k rpkt tp m c)
-> (forall a b.
    NodeT u nid k rpkt tp m a
    -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b)
-> (forall a b.
    NodeT u nid k rpkt tp m a
    -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a)
-> Applicative (NodeT u nid k rpkt tp m)
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
NodeT u nid k rpkt tp m (a -> b)
-> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
(a -> b -> c)
-> NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b
-> NodeT u nid k rpkt tp m c
forall a. a -> NodeT u nid k rpkt tp m a
forall a b.
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
forall a b.
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
forall a b.
NodeT u nid k rpkt tp m (a -> b)
-> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
forall a b c.
(a -> b -> c)
-> NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b
-> NodeT u nid k rpkt tp m c
forall u nid k rpkt tp (m :: * -> *).
Applicative m =>
Functor (NodeT u nid k rpkt tp m)
forall u nid k rpkt tp (m :: * -> *) a.
Applicative m =>
a -> NodeT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
NodeT u nid k rpkt tp m (a -> b)
-> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b
-> NodeT u nid k rpkt tp m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
$c<* :: forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m a
*> :: NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
$c*> :: forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
liftA2 :: (a -> b -> c)
-> NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b
-> NodeT u nid k rpkt tp m c
$cliftA2 :: forall u nid k rpkt tp (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b
-> NodeT u nid k rpkt tp m c
<*> :: NodeT u nid k rpkt tp m (a -> b)
-> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
$c<*> :: forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
NodeT u nid k rpkt tp m (a -> b)
-> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m b
pure :: a -> NodeT u nid k rpkt tp m a
$cpure :: forall u nid k rpkt tp (m :: * -> *) a.
Applicative m =>
a -> NodeT u nid k rpkt tp m a
$cp1Applicative :: forall u nid k rpkt tp (m :: * -> *).
Applicative m =>
Functor (NodeT u nid k rpkt tp m)
Applicative
    , Applicative (NodeT u nid k rpkt tp m)
a -> NodeT u nid k rpkt tp m a
Applicative (NodeT u nid k rpkt tp m)
-> (forall a b.
    NodeT u nid k rpkt tp m a
    -> (a -> NodeT u nid k rpkt tp m b) -> NodeT u nid k rpkt tp m b)
-> (forall a b.
    NodeT u nid k rpkt tp m a
    -> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b)
-> (forall a. a -> NodeT u nid k rpkt tp m a)
-> Monad (NodeT u nid k rpkt tp m)
NodeT u nid k rpkt tp m a
-> (a -> NodeT u nid k rpkt tp m b) -> NodeT u nid k rpkt tp m b
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
forall a. a -> NodeT u nid k rpkt tp m a
forall a b.
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
forall a b.
NodeT u nid k rpkt tp m a
-> (a -> NodeT u nid k rpkt tp m b) -> NodeT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *).
Monad m =>
Applicative (NodeT u nid k rpkt tp m)
forall u nid k rpkt tp (m :: * -> *) a.
Monad m =>
a -> NodeT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a b.
Monad m =>
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a b.
Monad m =>
NodeT u nid k rpkt tp m a
-> (a -> NodeT u nid k rpkt tp m b) -> NodeT u nid k rpkt tp m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> NodeT u nid k rpkt tp m a
$creturn :: forall u nid k rpkt tp (m :: * -> *) a.
Monad m =>
a -> NodeT u nid k rpkt tp m a
>> :: NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
$c>> :: forall u nid k rpkt tp (m :: * -> *) a b.
Monad m =>
NodeT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m b -> NodeT u nid k rpkt tp m b
>>= :: NodeT u nid k rpkt tp m a
-> (a -> NodeT u nid k rpkt tp m b) -> NodeT u nid k rpkt tp m b
$c>>= :: forall u nid k rpkt tp (m :: * -> *) a b.
Monad m =>
NodeT u nid k rpkt tp m a
-> (a -> NodeT u nid k rpkt tp m b) -> NodeT u nid k rpkt tp m b
$cp1Monad :: forall u nid k rpkt tp (m :: * -> *).
Monad m =>
Applicative (NodeT u nid k rpkt tp m)
Monad
    , Monad (NodeT u nid k rpkt tp m)
Monad (NodeT u nid k rpkt tp m)
-> (forall a. IO a -> NodeT u nid k rpkt tp m a)
-> MonadIO (NodeT u nid k rpkt tp m)
IO a -> NodeT u nid k rpkt tp m a
forall a. IO a -> NodeT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *).
MonadIO m =>
Monad (NodeT u nid k rpkt tp m)
forall u nid k rpkt tp (m :: * -> *) a.
MonadIO m =>
IO a -> NodeT u nid k rpkt tp m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> NodeT u nid k rpkt tp m a
$cliftIO :: forall u nid k rpkt tp (m :: * -> *) a.
MonadIO m =>
IO a -> NodeT u nid k rpkt tp m a
$cp1MonadIO :: forall u nid k rpkt tp (m :: * -> *).
MonadIO m =>
Monad (NodeT u nid k rpkt tp m)
MonadIO
    , MonadReader (NodeEnv u nid k rpkt)
    )

instance MonadUnliftIO m => MonadUnliftIO (NodeT u nid k rpkt tp m) where
  withRunInIO :: ((forall a. NodeT u nid k rpkt tp m a -> IO a) -> IO b)
-> NodeT u nid k rpkt tp m b
withRunInIO (forall a. NodeT u nid k rpkt tp m a -> IO a) -> IO b
inner = ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) b
-> NodeT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a.
ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
-> NodeT u nid k rpkt tp m a
NodeT (ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) b
 -> NodeT u nid k rpkt tp m b)
-> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) b
-> NodeT u nid k rpkt tp m b
forall a b. (a -> b) -> a -> b
$
    (NodeEnv u nid k rpkt -> ConnT tp m b)
-> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((NodeEnv u nid k rpkt -> ConnT tp m b)
 -> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) b)
-> (NodeEnv u nid k rpkt -> ConnT tp m b)
-> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) b
forall a b. (a -> b) -> a -> b
$ \NodeEnv u nid k rpkt
r ->
      ((forall a. ConnT tp m a -> IO a) -> IO b) -> ConnT tp m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ConnT tp m a -> IO a) -> IO b) -> ConnT tp m b)
-> ((forall a. ConnT tp m a -> IO a) -> IO b) -> ConnT tp m b
forall a b. (a -> b) -> a -> b
$ \forall a. ConnT tp m a -> IO a
run ->
        (forall a. NodeT u nid k rpkt tp m a -> IO a) -> IO b
inner (ConnT tp m a -> IO a
forall a. ConnT tp m a -> IO a
run (ConnT tp m a -> IO a)
-> (NodeT u nid k rpkt tp m a -> ConnT tp m a)
-> NodeT u nid k rpkt tp m a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeEnv u nid k rpkt -> NodeT u nid k rpkt tp m a -> ConnT tp m a
forall u nid k rpkt tp (m :: * -> *) a.
NodeEnv u nid k rpkt -> NodeT u nid k rpkt tp m a -> ConnT tp m a
runNodeT NodeEnv u nid k rpkt
r)

instance MonadTrans (NodeT u nid k rpkt tp) where
  lift :: m a -> NodeT u nid k rpkt tp m a
lift = ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
-> NodeT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a.
ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
-> NodeT u nid k rpkt tp m a
NodeT (ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
 -> NodeT u nid k rpkt tp m a)
-> (m a -> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a)
-> m a
-> NodeT u nid k rpkt tp m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnT tp m a -> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ConnT tp m a -> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a)
-> (m a -> ConnT tp m a)
-> m a
-> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ConnT tp m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance FromConn (NodeT u nid k rpkt) where
  fromConn :: ConnT tp n a -> NodeT u nid k rpkt tp n a
fromConn = ReaderT (NodeEnv u nid k rpkt) (ConnT tp n) a
-> NodeT u nid k rpkt tp n a
forall u nid k rpkt tp (m :: * -> *) a.
ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
-> NodeT u nid k rpkt tp m a
NodeT (ReaderT (NodeEnv u nid k rpkt) (ConnT tp n) a
 -> NodeT u nid k rpkt tp n a)
-> (ConnT tp n a -> ReaderT (NodeEnv u nid k rpkt) (ConnT tp n) a)
-> ConnT tp n a
-> NodeT u nid k rpkt tp n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnT tp n a -> ReaderT (NodeEnv u nid k rpkt) (ConnT tp n) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runNodeT :: NodeEnv u nid k rpkt -> NodeT u nid k rpkt tp m a -> ConnT tp m a
runNodeT :: NodeEnv u nid k rpkt -> NodeT u nid k rpkt tp m a -> ConnT tp m a
runNodeT NodeEnv u nid k rpkt
nEnv = (ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
 -> NodeEnv u nid k rpkt -> ConnT tp m a)
-> NodeEnv u nid k rpkt
-> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
-> ConnT tp m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
-> NodeEnv u nid k rpkt -> ConnT tp m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT NodeEnv u nid k rpkt
nEnv (ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a -> ConnT tp m a)
-> (NodeT u nid k rpkt tp m a
    -> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a)
-> NodeT u nid k rpkt tp m a
-> ConnT tp m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT u nid k rpkt tp m a
-> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
forall u nid k rpkt tp (m :: * -> *) a.
NodeT u nid k rpkt tp m a
-> ReaderT (NodeEnv u nid k rpkt) (ConnT tp m) a
unNodeT

runNodeT1 :: NodeEnv1 u nid k rpkt tp -> NodeT u nid k rpkt tp m a -> m a
runNodeT1 :: NodeEnv1 u nid k rpkt tp -> NodeT u nid k rpkt tp m a -> m a
runNodeT1 NodeEnv1 {ConnEnv tp
NodeEnv u nid k rpkt
connEnv :: ConnEnv tp
nodeEnv :: NodeEnv u nid k rpkt
connEnv :: forall u nid k rpkt tp. NodeEnv1 u nid k rpkt tp -> ConnEnv tp
nodeEnv :: forall u nid k rpkt tp.
NodeEnv1 u nid k rpkt tp -> NodeEnv u nid k rpkt
..} = ConnEnv tp -> ConnT tp m a -> m a
forall tp (m :: * -> *) a. ConnEnv tp -> ConnT tp m a -> m a
runConnT ConnEnv tp
connEnv (ConnT tp m a -> m a)
-> (NodeT u nid k rpkt tp m a -> ConnT tp m a)
-> NodeT u nid k rpkt tp m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeEnv u nid k rpkt -> NodeT u nid k rpkt tp m a -> ConnT tp m a
forall u nid k rpkt tp (m :: * -> *) a.
NodeEnv u nid k rpkt -> NodeT u nid k rpkt tp m a -> ConnT tp m a
runNodeT NodeEnv u nid k rpkt
nodeEnv

initEnv :: MonadIO m => u -> nid -> IO k -> m (NodeEnv u nid k rpkt)
initEnv :: u -> nid -> IO k -> m (NodeEnv u nid k rpkt)
initEnv u
uEnv nid
nodeId IO k
sessionGen = do
  TVar Bool
nodeStatus  <- Bool -> m (TVar Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Bool
True
  TVar (Maybe (SessionEnv u nid k rpkt))
nodeSession <- Maybe (SessionEnv u nid k rpkt)
-> m (TVar (Maybe (SessionEnv u nid k rpkt)))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Maybe (SessionEnv u nid k rpkt)
forall a. Maybe a
Nothing
  IOHashMap k (SessionEnv u nid k rpkt)
sessionList <- m (IOHashMap k (SessionEnv u nid k rpkt))
forall (m :: * -> *) k v. MonadIO m => m (IOHashMap k v)
HM.empty
  TVar Int64
nodeTimer   <- Int64 -> m (TVar Int64)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (Int64 -> m (TVar Int64)) -> m Int64 -> m (TVar Int64)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Int64
forall (m :: * -> *). MonadIO m => m Int64
getEpochTime
  TVar (Maybe (u -> IO ()))
onNodeLeave <- Maybe (u -> IO ()) -> m (TVar (Maybe (u -> IO ())))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Maybe (u -> IO ())
forall a. Maybe a
Nothing
  TVar Int64
sessTimeout <- Int64 -> m (TVar Int64)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int64
300
  NodeEnv u nid k rpkt -> m (NodeEnv u nid k rpkt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeEnv :: forall u nid k rpkt.
u
-> TVar Bool
-> NodeMode
-> SessionMode
-> TVar (Maybe (SessionEnv u nid k rpkt))
-> IOHashMap k (SessionEnv u nid k rpkt)
-> IO k
-> TVar Int64
-> nid
-> TVar Int64
-> TVar (Maybe (u -> IO ()))
-> NodeEnv u nid k rpkt
NodeEnv
    { nodeMode :: NodeMode
nodeMode    = NodeMode
Multi
    , sessionMode :: SessionMode
sessionMode = SessionMode
SingleAction
    , u
nid
IO k
TVar Bool
TVar Int64
TVar (Maybe (SessionEnv u nid k rpkt))
TVar (Maybe (u -> IO ()))
IOHashMap k (SessionEnv u nid k rpkt)
sessTimeout :: TVar Int64
onNodeLeave :: TVar (Maybe (u -> IO ()))
nodeTimer :: TVar Int64
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
nodeStatus :: TVar Bool
sessionGen :: IO k
nodeId :: nid
uEnv :: u
onNodeLeave :: TVar (Maybe (u -> IO ()))
sessTimeout :: TVar Int64
nodeId :: nid
nodeTimer :: TVar Int64
sessionGen :: IO k
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
nodeStatus :: TVar Bool
uEnv :: u
..
    }

withEnv :: (Monad m) =>  u -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
withEnv :: u -> NodeT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
withEnv u
u NodeT u nid k rpkt tp m a
m = do
  NodeEnv u nid k rpkt
env0 <- NodeT u nid k rpkt tp m (NodeEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  ConnT tp m a -> NodeT u nid k rpkt tp m a
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn (ConnT tp m a -> NodeT u nid k rpkt tp m a)
-> ConnT tp m a -> NodeT u nid k rpkt tp m a
forall a b. (a -> b) -> a -> b
$ NodeEnv u nid k rpkt -> NodeT u nid k rpkt tp m a -> ConnT tp m a
forall u nid k rpkt tp (m :: * -> *) a.
NodeEnv u nid k rpkt -> NodeT u nid k rpkt tp m a -> ConnT tp m a
runNodeT (NodeEnv u nid k rpkt
env0 {uEnv :: u
uEnv=u
u}) NodeT u nid k rpkt tp m a
m

setNodeMode :: NodeMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setNodeMode :: NodeMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setNodeMode NodeMode
mode NodeEnv u nid k rpkt
nodeEnv = NodeEnv u nid k rpkt
nodeEnv {nodeMode :: NodeMode
nodeMode = NodeMode
mode}

setSessionMode :: SessionMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setSessionMode :: SessionMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setSessionMode SessionMode
mode NodeEnv u nid k rpkt
nodeEnv = NodeEnv u nid k rpkt
nodeEnv {sessionMode :: SessionMode
sessionMode = SessionMode
mode}

setDefaultSessionTimeout :: TVar Int64 -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setDefaultSessionTimeout :: TVar Int64 -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setDefaultSessionTimeout TVar Int64
t NodeEnv u nid k rpkt
nodeEnv = NodeEnv u nid k rpkt
nodeEnv { sessTimeout :: TVar Int64
sessTimeout = TVar Int64
t }

setDefaultSessionTimeout1 :: MonadIO m => NodeEnv1 u nid k rpkt tp -> Int64 -> m ()
setDefaultSessionTimeout1 :: NodeEnv1 u nid k rpkt tp -> Int64 -> m ()
setDefaultSessionTimeout1 NodeEnv1 {ConnEnv tp
NodeEnv u nid k rpkt
connEnv :: ConnEnv tp
nodeEnv :: NodeEnv u nid k rpkt
connEnv :: forall u nid k rpkt tp. NodeEnv1 u nid k rpkt tp -> ConnEnv tp
nodeEnv :: forall u nid k rpkt tp.
NodeEnv1 u nid k rpkt tp -> NodeEnv u nid k rpkt
..} = STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> (Int64 -> STM ()) -> Int64 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar Int64 -> Int64 -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (NodeEnv u nid k rpkt -> TVar Int64
forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
sessTimeout NodeEnv u nid k rpkt
nodeEnv)


initEnv1
  :: MonadIO m
  => (NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt)
  -> ConnEnv tp -> u -> nid -> IO k -> m (NodeEnv1 u nid k rpkt tp)
initEnv1 :: (NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt)
-> ConnEnv tp -> u -> nid -> IO k -> m (NodeEnv1 u nid k rpkt tp)
initEnv1 NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
mapEnv ConnEnv tp
connEnv u
uEnv nid
nid IO k
gen = do
  NodeEnv u nid k rpkt
nodeEnv <- NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
mapEnv (NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt)
-> m (NodeEnv u nid k rpkt) -> m (NodeEnv u nid k rpkt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> nid -> IO k -> m (NodeEnv u nid k rpkt)
forall (m :: * -> *) u nid k rpkt.
MonadIO m =>
u -> nid -> IO k -> m (NodeEnv u nid k rpkt)
initEnv u
uEnv nid
nid IO k
gen
  NodeEnv1 u nid k rpkt tp -> m (NodeEnv1 u nid k rpkt tp)
forall (m :: * -> *) a. Monad m => a -> m a
return NodeEnv1 :: forall u nid k rpkt tp.
NodeEnv u nid k rpkt -> ConnEnv tp -> NodeEnv1 u nid k rpkt tp
NodeEnv1 {ConnEnv tp
NodeEnv u nid k rpkt
nodeEnv :: NodeEnv u nid k rpkt
connEnv :: ConnEnv tp
connEnv :: ConnEnv tp
nodeEnv :: NodeEnv u nid k rpkt
..}

getEnv1
  :: (Monad m, Transport tp)
  => NodeT u nid k rpkt tp m (NodeEnv1 u nid k rpkt tp)
getEnv1 :: NodeT u nid k rpkt tp m (NodeEnv1 u nid k rpkt tp)
getEnv1 = do
  ConnEnv tp
connEnv <- ConnT tp m (ConnEnv tp) -> NodeT u nid k rpkt tp m (ConnEnv tp)
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn ConnT tp m (ConnEnv tp)
forall r (m :: * -> *). MonadReader r m => m r
ask
  NodeEnv u nid k rpkt
nodeEnv <- NodeT u nid k rpkt tp m (NodeEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  NodeEnv1 u nid k rpkt tp
-> NodeT u nid k rpkt tp m (NodeEnv1 u nid k rpkt tp)
forall (m :: * -> *) a. Monad m => a -> m a
return NodeEnv1 :: forall u nid k rpkt tp.
NodeEnv u nid k rpkt -> ConnEnv tp -> NodeEnv1 u nid k rpkt tp
NodeEnv1 {ConnEnv tp
NodeEnv u nid k rpkt
nodeEnv :: NodeEnv u nid k rpkt
connEnv :: ConnEnv tp
connEnv :: ConnEnv tp
nodeEnv :: NodeEnv u nid k rpkt
..}

runSessionT_ :: Monad m => SessionEnv u nid k rpkt -> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
runSessionT_ :: SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
runSessionT_ SessionEnv u nid k rpkt
aEnv = ConnT tp m a -> NodeT u nid k rpkt tp m a
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn (ConnT tp m a -> NodeT u nid k rpkt tp m a)
-> (SessionT u nid k rpkt tp m a -> ConnT tp m a)
-> SessionT u nid k rpkt tp m a
-> NodeT u nid k rpkt tp m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> ConnT tp m a
forall u nid k rpkt tp (m :: * -> *) a.
SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> ConnT tp m a
runSessionT SessionEnv u nid k rpkt
aEnv

withSessionT
  :: (MonadUnliftIO m, Eq k, Hashable k)
  => Maybe Int64 -> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
withSessionT :: Maybe Int64
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
withSessionT Maybe Int64
sTout SessionT u nid k rpkt tp m a
sessionT =
  NodeT u nid k rpkt tp m k
-> (k -> NodeT u nid k rpkt tp m ())
-> (k -> NodeT u nid k rpkt tp m a)
-> NodeT u nid k rpkt tp m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket NodeT u nid k rpkt tp m k
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
NodeT u nid k rpkt tp m k
nextSessionId k -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) k u nid rpkt tp.
(MonadIO m, Eq k, Hashable k) =>
k -> NodeT u nid k rpkt tp m ()
removeSession ((k -> NodeT u nid k rpkt tp m a) -> NodeT u nid k rpkt tp m a)
-> (k -> NodeT u nid k rpkt tp m a) -> NodeT u nid k rpkt tp m a
forall a b. (a -> b) -> a -> b
$ \k
sid -> do
    SessionEnv u nid k rpkt
aEnv <- Maybe Int64
-> k -> NodeT u nid k rpkt tp m (SessionEnv u nid k rpkt)
forall (m :: * -> *) k u nid rpkt tp.
(MonadIO m, Eq k, Hashable k) =>
Maybe Int64
-> k -> NodeT u nid k rpkt tp m (SessionEnv u nid k rpkt)
newSessionEnv Maybe Int64
sTout k
sid
    SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
forall (m :: * -> *) u nid k rpkt tp a.
Monad m =>
SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
runSessionT_ SessionEnv u nid k rpkt
aEnv SessionT u nid k rpkt tp m a
sessionT

newSessionEnv :: (MonadIO m, Eq k, Hashable k) => Maybe Int64 -> k -> NodeT u nid k rpkt tp m (SessionEnv u nid k rpkt)
newSessionEnv :: Maybe Int64
-> k -> NodeT u nid k rpkt tp m (SessionEnv u nid k rpkt)
newSessionEnv Maybe Int64
sTout k
sid = do
  NodeEnv{u
nid
IO k
TVar Bool
TVar Int64
TVar (Maybe (SessionEnv u nid k rpkt))
TVar (Maybe (u -> IO ()))
IOHashMap k (SessionEnv u nid k rpkt)
SessionMode
NodeMode
onNodeLeave :: TVar (Maybe (u -> IO ()))
sessTimeout :: TVar Int64
nodeId :: nid
nodeTimer :: TVar Int64
sessionGen :: IO k
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: SessionMode
nodeMode :: NodeMode
nodeStatus :: TVar Bool
uEnv :: u
onNodeLeave :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (u -> IO ()))
sessTimeout :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
nodeId :: forall u nid k rpkt. NodeEnv u nid k rpkt -> nid
nodeTimer :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
sessionGen :: forall u nid k rpkt. NodeEnv u nid k rpkt -> IO k
sessionList :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> SessionMode
nodeMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> NodeMode
nodeStatus :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Bool
uEnv :: forall u nid k rpkt. NodeEnv u nid k rpkt -> u
..} <- NodeT u nid k rpkt tp m (NodeEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int64
dTout <- TVar Int64 -> NodeT u nid k rpkt tp m Int64
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar Int64
sessTimeout
  SessionEnv u nid k rpkt
sEnv <- u
-> nid
-> k
-> Int64
-> [Maybe rpkt]
-> NodeT u nid k rpkt tp m (SessionEnv u nid k rpkt)
forall (m :: * -> *) u nid k rpkt.
MonadIO m =>
u
-> nid -> k -> Int64 -> [Maybe rpkt] -> m (SessionEnv u nid k rpkt)
S.newSessionEnv u
uEnv nid
nodeId k
sid (Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe Int64
dTout Maybe Int64
sTout) []
  case NodeMode
nodeMode of
    NodeMode
Single -> STM () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> NodeT u nid k rpkt tp m ())
-> STM () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe (SessionEnv u nid k rpkt)
sess <- TVar (Maybe (SessionEnv u nid k rpkt))
-> STM (Maybe (SessionEnv u nid k rpkt))
forall a. TVar a -> STM a
readTVar TVar (Maybe (SessionEnv u nid k rpkt))
nodeSession
      case Maybe (SessionEnv u nid k rpkt)
sess of
        Maybe (SessionEnv u nid k rpkt)
Nothing -> TVar (Maybe (SessionEnv u nid k rpkt))
-> Maybe (SessionEnv u nid k rpkt) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (SessionEnv u nid k rpkt))
nodeSession (Maybe (SessionEnv u nid k rpkt) -> STM ())
-> Maybe (SessionEnv u nid k rpkt) -> STM ()
forall a b. (a -> b) -> a -> b
$ SessionEnv u nid k rpkt -> Maybe (SessionEnv u nid k rpkt)
forall a. a -> Maybe a
Just SessionEnv u nid k rpkt
sEnv
        Just SessionEnv u nid k rpkt
_  -> do
          Bool
state <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
nodeStatus
          Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
state STM ()
forall a. STM a
retrySTM
    NodeMode
Multi -> k
-> SessionEnv u nid k rpkt
-> IOHashMap k (SessionEnv u nid k rpkt)
-> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) k v.
(MonadIO m, Eq k, Hashable k) =>
k -> v -> IOHashMap k v -> m ()
HM.insert k
sid SessionEnv u nid k rpkt
sEnv IOHashMap k (SessionEnv u nid k rpkt)
sessionList
  SessionEnv u nid k rpkt
-> NodeT u nid k rpkt tp m (SessionEnv u nid k rpkt)
forall (m :: * -> *) a. Monad m => a -> m a
return SessionEnv u nid k rpkt
sEnv

nextSessionId :: MonadIO m => NodeT u nid k rpkt tp m k
nextSessionId :: NodeT u nid k rpkt tp m k
nextSessionId = IO k -> NodeT u nid k rpkt tp m k
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO k -> NodeT u nid k rpkt tp m k)
-> NodeT u nid k rpkt tp m (IO k) -> NodeT u nid k rpkt tp m k
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (NodeEnv u nid k rpkt -> IO k) -> NodeT u nid k rpkt tp m (IO k)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv u nid k rpkt -> IO k
forall u nid k rpkt. NodeEnv u nid k rpkt -> IO k
sessionGen

removeSession :: (MonadIO m, Eq k, Hashable k) => k -> NodeT u nid k rpkt tp m ()
removeSession :: k -> NodeT u nid k rpkt tp m ()
removeSession k
mid = do
  NodeEnv{u
nid
IO k
TVar Bool
TVar Int64
TVar (Maybe (SessionEnv u nid k rpkt))
TVar (Maybe (u -> IO ()))
IOHashMap k (SessionEnv u nid k rpkt)
SessionMode
NodeMode
onNodeLeave :: TVar (Maybe (u -> IO ()))
sessTimeout :: TVar Int64
nodeId :: nid
nodeTimer :: TVar Int64
sessionGen :: IO k
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: SessionMode
nodeMode :: NodeMode
nodeStatus :: TVar Bool
uEnv :: u
onNodeLeave :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (u -> IO ()))
sessTimeout :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
nodeId :: forall u nid k rpkt. NodeEnv u nid k rpkt -> nid
nodeTimer :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
sessionGen :: forall u nid k rpkt. NodeEnv u nid k rpkt -> IO k
sessionList :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> SessionMode
nodeMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> NodeMode
nodeStatus :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Bool
uEnv :: forall u nid k rpkt. NodeEnv u nid k rpkt -> u
..} <- NodeT u nid k rpkt tp m (NodeEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  case NodeMode
nodeMode of
    NodeMode
Single -> STM () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> NodeT u nid k rpkt tp m ())
-> STM () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (SessionEnv u nid k rpkt))
-> Maybe (SessionEnv u nid k rpkt) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (SessionEnv u nid k rpkt))
nodeSession Maybe (SessionEnv u nid k rpkt)
forall a. Maybe a
Nothing
    NodeMode
Multi  -> k
-> IOHashMap k (SessionEnv u nid k rpkt)
-> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) k v.
(MonadIO m, Eq k, Hashable k) =>
k -> IOHashMap k v -> m ()
HM.delete k
mid IOHashMap k (SessionEnv u nid k rpkt)
sessionList

busy :: MonadIO m => NodeT u nid k rpkt tp m Bool
busy :: NodeT u nid k rpkt tp m Bool
busy = do
  NodeEnv{u
nid
IO k
TVar Bool
TVar Int64
TVar (Maybe (SessionEnv u nid k rpkt))
TVar (Maybe (u -> IO ()))
IOHashMap k (SessionEnv u nid k rpkt)
SessionMode
NodeMode
onNodeLeave :: TVar (Maybe (u -> IO ()))
sessTimeout :: TVar Int64
nodeId :: nid
nodeTimer :: TVar Int64
sessionGen :: IO k
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: SessionMode
nodeMode :: NodeMode
nodeStatus :: TVar Bool
uEnv :: u
onNodeLeave :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (u -> IO ()))
sessTimeout :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
nodeId :: forall u nid k rpkt. NodeEnv u nid k rpkt -> nid
nodeTimer :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
sessionGen :: forall u nid k rpkt. NodeEnv u nid k rpkt -> IO k
sessionList :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> SessionMode
nodeMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> NodeMode
nodeStatus :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Bool
uEnv :: forall u nid k rpkt. NodeEnv u nid k rpkt -> u
..} <- NodeT u nid k rpkt tp m (NodeEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  case NodeMode
nodeMode of
    NodeMode
Single -> Maybe (SessionEnv u nid k rpkt) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (SessionEnv u nid k rpkt) -> Bool)
-> NodeT u nid k rpkt tp m (Maybe (SessionEnv u nid k rpkt))
-> NodeT u nid k rpkt tp m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Maybe (SessionEnv u nid k rpkt))
-> NodeT u nid k rpkt tp m (Maybe (SessionEnv u nid k rpkt))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (SessionEnv u nid k rpkt))
nodeSession
    NodeMode
Multi  -> Bool -> NodeT u nid k rpkt tp m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

tryMainLoop
  :: (MonadUnliftIO m, Transport tp, RecvPacket rpkt, GetPacketId k rpkt, Eq k, Hashable k)
  => (rpkt -> m Bool) -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
tryMainLoop :: (rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
tryMainLoop rpkt -> m Bool
preprocess SessionT u nid k rpkt tp m ()
sessionHandler = do
  Either SomeException ()
r <- NodeT u nid k rpkt tp m ()
-> NodeT u nid k rpkt tp m (Either SomeException ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (NodeT u nid k rpkt tp m ()
 -> NodeT u nid k rpkt tp m (Either SomeException ()))
-> NodeT u nid k rpkt tp m ()
-> NodeT u nid k rpkt tp m (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ (rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) tp rpkt k u nid.
(MonadUnliftIO m, Transport tp, RecvPacket rpkt,
 GetPacketId k rpkt, Eq k, Hashable k) =>
(rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
mainLoop rpkt -> m Bool
preprocess SessionT u nid k rpkt tp m ()
sessionHandler
  case Either SomeException ()
r of
    Left SomeException
_  -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) tp u nid k rpkt.
(MonadIO m, Transport tp) =>
NodeT u nid k rpkt tp m ()
stopNodeT
    Right ()
_ -> () -> NodeT u nid k rpkt tp m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

mainLoop
  :: (MonadUnliftIO m, Transport tp, RecvPacket rpkt, GetPacketId k rpkt, Eq k, Hashable k)
  => (rpkt -> m Bool) -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
mainLoop :: (rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
mainLoop rpkt -> m Bool
preprocess SessionT u nid k rpkt tp m ()
sessionHandler = do
  NodeEnv{u
nid
IO k
TVar Bool
TVar Int64
TVar (Maybe (SessionEnv u nid k rpkt))
TVar (Maybe (u -> IO ()))
IOHashMap k (SessionEnv u nid k rpkt)
SessionMode
NodeMode
onNodeLeave :: TVar (Maybe (u -> IO ()))
sessTimeout :: TVar Int64
nodeId :: nid
nodeTimer :: TVar Int64
sessionGen :: IO k
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: SessionMode
nodeMode :: NodeMode
nodeStatus :: TVar Bool
uEnv :: u
onNodeLeave :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (u -> IO ()))
sessTimeout :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
nodeId :: forall u nid k rpkt. NodeEnv u nid k rpkt -> nid
nodeTimer :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
sessionGen :: forall u nid k rpkt. NodeEnv u nid k rpkt -> IO k
sessionList :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> SessionMode
nodeMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> NodeMode
nodeStatus :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Bool
uEnv :: forall u nid k rpkt. NodeEnv u nid k rpkt -> u
..} <- NodeT u nid k rpkt tp m (NodeEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  rpkt
rpkt <- ConnT tp m rpkt -> NodeT u nid k rpkt tp m rpkt
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn ConnT tp m rpkt
forall (m :: * -> *) tp pkt.
(MonadUnliftIO m, Transport tp, RecvPacket pkt) =>
ConnT tp m pkt
receive
  Int64 -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
Int64 -> NodeT u nid k rpkt tp m ()
setTimer (Int64 -> NodeT u nid k rpkt tp m ())
-> NodeT u nid k rpkt tp m Int64 -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NodeT u nid k rpkt tp m Int64
forall (m :: * -> *). MonadIO m => m Int64
getEpochTime
  Bool
r <- m Bool -> NodeT u nid k rpkt tp m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> NodeT u nid k rpkt tp m Bool)
-> m Bool -> NodeT u nid k rpkt tp m Bool
forall a b. (a -> b) -> a -> b
$ rpkt -> m Bool
preprocess rpkt
rpkt
  Bool -> NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
r (NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ())
-> NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ NodeT u nid k rpkt tp m (Async ()) -> NodeT u nid k rpkt tp m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (NodeT u nid k rpkt tp m (Async ()) -> NodeT u nid k rpkt tp m ())
-> (NodeT u nid k rpkt tp m ()
    -> NodeT u nid k rpkt tp m (Async ()))
-> NodeT u nid k rpkt tp m ()
-> NodeT u nid k rpkt tp m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ())
-> NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ rpkt -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) tp k rpkt u nid.
(MonadUnliftIO m, Transport tp, GetPacketId k rpkt, Eq k,
 Hashable k) =>
rpkt -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
tryDoFeed rpkt
rpkt SessionT u nid k rpkt tp m ()
sessionHandler

tryDoFeed
  :: (MonadUnliftIO m, Transport tp, GetPacketId k rpkt, Eq k, Hashable k)
  => rpkt -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
tryDoFeed :: rpkt -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
tryDoFeed rpkt
rpkt SessionT u nid k rpkt tp m ()
sessionHandler = do
  Either SomeException ()
r <- NodeT u nid k rpkt tp m ()
-> NodeT u nid k rpkt tp m (Either SomeException ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (NodeT u nid k rpkt tp m ()
 -> NodeT u nid k rpkt tp m (Either SomeException ()))
-> NodeT u nid k rpkt tp m ()
-> NodeT u nid k rpkt tp m (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ rpkt -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) k rpkt u nid tp.
(MonadUnliftIO m, GetPacketId k rpkt, Eq k, Hashable k) =>
rpkt -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
doFeed rpkt
rpkt SessionT u nid k rpkt tp m ()
sessionHandler
  case Either SomeException ()
r of
    Left SomeException
e  -> IO () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> NodeT u nid k rpkt tp m ())
-> IO () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
errorM String
"Metro.Node" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"DoFeed Error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
    Right ()
_ -> () -> NodeT u nid k rpkt tp m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

doFeed
  :: (MonadUnliftIO m, GetPacketId k rpkt, Eq k, Hashable k)
  => rpkt -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
doFeed :: rpkt -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
doFeed rpkt
rpkt SessionT u nid k rpkt tp m ()
sessionHandler = do
  NodeEnv{u
nid
IO k
TVar Bool
TVar Int64
TVar (Maybe (SessionEnv u nid k rpkt))
TVar (Maybe (u -> IO ()))
IOHashMap k (SessionEnv u nid k rpkt)
SessionMode
NodeMode
onNodeLeave :: TVar (Maybe (u -> IO ()))
sessTimeout :: TVar Int64
nodeId :: nid
nodeTimer :: TVar Int64
sessionGen :: IO k
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: SessionMode
nodeMode :: NodeMode
nodeStatus :: TVar Bool
uEnv :: u
onNodeLeave :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (u -> IO ()))
sessTimeout :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
nodeId :: forall u nid k rpkt. NodeEnv u nid k rpkt -> nid
nodeTimer :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
sessionGen :: forall u nid k rpkt. NodeEnv u nid k rpkt -> IO k
sessionList :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> SessionMode
nodeMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> NodeMode
nodeStatus :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Bool
uEnv :: forall u nid k rpkt. NodeEnv u nid k rpkt -> u
..} <- NodeT u nid k rpkt tp m (NodeEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Maybe (SessionEnv u nid k rpkt)
v <- case NodeMode
nodeMode of
         NodeMode
Single -> TVar (Maybe (SessionEnv u nid k rpkt))
-> NodeT u nid k rpkt tp m (Maybe (SessionEnv u nid k rpkt))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (SessionEnv u nid k rpkt))
nodeSession
         NodeMode
Multi  -> k
-> IOHashMap k (SessionEnv u nid k rpkt)
-> NodeT u nid k rpkt tp m (Maybe (SessionEnv u nid k rpkt))
forall (m :: * -> *) k v.
(MonadIO m, Eq k, Hashable k) =>
k -> IOHashMap k v -> m (Maybe v)
HM.lookup (rpkt -> k
forall k pkt. GetPacketId k pkt => pkt -> k
getPacketId rpkt
rpkt) IOHashMap k (SessionEnv u nid k rpkt)
sessionList
  case Maybe (SessionEnv u nid k rpkt)
v of
    Just SessionEnv u nid k rpkt
aEnv ->
      SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) u nid k rpkt tp a.
Monad m =>
SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
runSessionT_ SessionEnv u nid k rpkt
aEnv (SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ())
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ Maybe rpkt -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) rpkt u nid k tp.
MonadIO m =>
Maybe rpkt -> SessionT u nid k rpkt tp m ()
feed (Maybe rpkt -> SessionT u nid k rpkt tp m ())
-> Maybe rpkt -> SessionT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ rpkt -> Maybe rpkt
forall a. a -> Maybe a
Just rpkt
rpkt
    Maybe (SessionEnv u nid k rpkt)
Nothing    -> do
      let sid :: k
sid = rpkt -> k
forall k pkt. GetPacketId k pkt => pkt -> k
getPacketId rpkt
rpkt
      Int64
dTout <- TVar Int64 -> NodeT u nid k rpkt tp m Int64
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar Int64
sessTimeout
      SessionEnv u nid k rpkt
sEnv <- u
-> nid
-> k
-> Int64
-> [Maybe rpkt]
-> NodeT u nid k rpkt tp m (SessionEnv u nid k rpkt)
forall (m :: * -> *) u nid k rpkt.
MonadIO m =>
u
-> nid -> k -> Int64 -> [Maybe rpkt] -> m (SessionEnv u nid k rpkt)
S.newSessionEnv u
uEnv nid
nodeId k
sid Int64
dTout [rpkt -> Maybe rpkt
forall a. a -> Maybe a
Just rpkt
rpkt]
      Bool -> NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SessionMode
sessionMode SessionMode -> SessionMode -> Bool
forall a. Eq a => a -> a -> Bool
== SessionMode
MultiAction) (NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ())
-> NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$
        case NodeMode
nodeMode of
          NodeMode
Single -> STM () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> NodeT u nid k rpkt tp m ())
-> STM () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (SessionEnv u nid k rpkt))
-> Maybe (SessionEnv u nid k rpkt) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (SessionEnv u nid k rpkt))
nodeSession (Maybe (SessionEnv u nid k rpkt) -> STM ())
-> Maybe (SessionEnv u nid k rpkt) -> STM ()
forall a b. (a -> b) -> a -> b
$ SessionEnv u nid k rpkt -> Maybe (SessionEnv u nid k rpkt)
forall a. a -> Maybe a
Just SessionEnv u nid k rpkt
sEnv
          NodeMode
Multi  -> k
-> SessionEnv u nid k rpkt
-> IOHashMap k (SessionEnv u nid k rpkt)
-> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) k v.
(MonadIO m, Eq k, Hashable k) =>
k -> v -> IOHashMap k v -> m ()
HM.insert k
sid SessionEnv u nid k rpkt
sEnv IOHashMap k (SessionEnv u nid k rpkt)
sessionList
      NodeT u nid k rpkt tp m k
-> (k -> NodeT u nid k rpkt tp m ())
-> (k -> NodeT u nid k rpkt tp m ())
-> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (k -> NodeT u nid k rpkt tp m k
forall (m :: * -> *) a. Monad m => a -> m a
return k
sid) k -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) k u nid rpkt tp.
(MonadIO m, Eq k, Hashable k) =>
k -> NodeT u nid k rpkt tp m ()
removeSession ((k -> NodeT u nid k rpkt tp m ()) -> NodeT u nid k rpkt tp m ())
-> (k -> NodeT u nid k rpkt tp m ()) -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ \k
_ ->
        SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) u nid k rpkt tp a.
Monad m =>
SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
runSessionT_ SessionEnv u nid k rpkt
sEnv SessionT u nid k rpkt tp m ()
sessionHandler

startNodeT
  :: (MonadUnliftIO m, Transport tp, RecvPacket rpkt, GetPacketId k rpkt, Eq k, Hashable k)
  => SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
startNodeT :: SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
startNodeT = (rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) tp rpkt k u nid.
(MonadUnliftIO m, Transport tp, RecvPacket rpkt,
 GetPacketId k rpkt, Eq k, Hashable k) =>
(rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
startNodeT_ (m Bool -> rpkt -> m Bool
forall a b. a -> b -> a
const (m Bool -> rpkt -> m Bool) -> m Bool -> rpkt -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

startNodeT_
  :: (MonadUnliftIO m, Transport tp, RecvPacket rpkt, GetPacketId k rpkt, Eq k, Hashable k)
  => (rpkt -> m Bool) -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
startNodeT_ :: (rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
startNodeT_ rpkt -> m Bool
preprocess SessionT u nid k rpkt tp m ()
sessionHandler = do
  Async ()
sess <- NodeT u nid k rpkt tp m (Async ())
forall (m :: * -> *) k u nid rpkt tp.
(MonadUnliftIO m, Eq k, Hashable k) =>
NodeT u nid k rpkt tp m (Async ())
runCheckSessionState
  (ContT () (NodeT u nid k rpkt tp m) ()
-> (() -> NodeT u nid k rpkt tp m ()) -> NodeT u nid k rpkt tp m ()
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
`runContT` () -> NodeT u nid k rpkt tp m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (ContT () (NodeT u nid k rpkt tp m) ()
 -> NodeT u nid k rpkt tp m ())
-> ContT () (NodeT u nid k rpkt tp m) ()
-> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ ((() -> ContT () (NodeT u nid k rpkt tp m) ())
 -> ContT () (NodeT u nid k rpkt tp m) ())
-> ContT () (NodeT u nid k rpkt tp m) ()
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((() -> ContT () (NodeT u nid k rpkt tp m) ())
  -> ContT () (NodeT u nid k rpkt tp m) ())
 -> ContT () (NodeT u nid k rpkt tp m) ())
-> ((() -> ContT () (NodeT u nid k rpkt tp m) ())
    -> ContT () (NodeT u nid k rpkt tp m) ())
-> ContT () (NodeT u nid k rpkt tp m) ()
forall a b. (a -> b) -> a -> b
$ \() -> ContT () (NodeT u nid k rpkt tp m) ()
exit -> ContT () (NodeT u nid k rpkt tp m) ()
-> ContT () (NodeT u nid k rpkt tp m) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ContT () (NodeT u nid k rpkt tp m) ()
 -> ContT () (NodeT u nid k rpkt tp m) ())
-> ContT () (NodeT u nid k rpkt tp m) ()
-> ContT () (NodeT u nid k rpkt tp m) ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
alive <- NodeT u nid k rpkt tp m Bool
-> ContT () (NodeT u nid k rpkt tp m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift NodeT u nid k rpkt tp m Bool
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
NodeT u nid k rpkt tp m Bool
nodeState
    if Bool
alive then NodeT u nid k rpkt tp m () -> ContT () (NodeT u nid k rpkt tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NodeT u nid k rpkt tp m ()
 -> ContT () (NodeT u nid k rpkt tp m) ())
-> NodeT u nid k rpkt tp m ()
-> ContT () (NodeT u nid k rpkt tp m) ()
forall a b. (a -> b) -> a -> b
$ (rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) tp rpkt k u nid.
(MonadUnliftIO m, Transport tp, RecvPacket rpkt,
 GetPacketId k rpkt, Eq k, Hashable k) =>
(rpkt -> m Bool)
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
tryMainLoop rpkt -> m Bool
preprocess SessionT u nid k rpkt tp m ()
sessionHandler
             else () -> ContT () (NodeT u nid k rpkt tp m) ()
exit ()

  Async () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Async ()
sess
  NodeT u nid k rpkt tp m ()
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
NodeT u nid k rpkt tp m ()
doFeedError

nodeState :: MonadIO m => NodeT u nid k rpkt tp m Bool
nodeState :: NodeT u nid k rpkt tp m Bool
nodeState = TVar Bool -> NodeT u nid k rpkt tp m Bool
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar Bool -> NodeT u nid k rpkt tp m Bool)
-> NodeT u nid k rpkt tp m (TVar Bool)
-> NodeT u nid k rpkt tp m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (NodeEnv u nid k rpkt -> TVar Bool)
-> NodeT u nid k rpkt tp m (TVar Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv u nid k rpkt -> TVar Bool
forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Bool
nodeStatus

doFeedError :: MonadIO m => NodeT u nid k rpkt tp m ()
doFeedError :: NodeT u nid k rpkt tp m ()
doFeedError =
  (NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt))
-> NodeT u nid k rpkt tp m (IOHashMap k (SessionEnv u nid k rpkt))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
forall u nid k rpkt.
NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
sessionList NodeT u nid k rpkt tp m (IOHashMap k (SessionEnv u nid k rpkt))
-> (IOHashMap k (SessionEnv u nid k rpkt)
    -> NodeT u nid k rpkt tp m [SessionEnv u nid k rpkt])
-> NodeT u nid k rpkt tp m [SessionEnv u nid k rpkt]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IOHashMap k (SessionEnv u nid k rpkt)
-> NodeT u nid k rpkt tp m [SessionEnv u nid k rpkt]
forall (m :: * -> *) k v. MonadIO m => IOHashMap k v -> m [v]
HM.elems NodeT u nid k rpkt tp m [SessionEnv u nid k rpkt]
-> ([SessionEnv u nid k rpkt] -> NodeT u nid k rpkt tp m ())
-> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ())
-> [SessionEnv u nid k rpkt] -> NodeT u nid k rpkt tp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
go
  where go :: MonadIO m => SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
        go :: SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
go SessionEnv u nid k rpkt
aEnv = SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) u nid k rpkt tp a.
Monad m =>
SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
runSessionT_ SessionEnv u nid k rpkt
aEnv (SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ())
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ Maybe rpkt -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) rpkt u nid k tp.
MonadIO m =>
Maybe rpkt -> SessionT u nid k rpkt tp m ()
feed Maybe rpkt
forall a. Maybe a
Nothing

stopNodeT :: (MonadIO m, Transport tp) => NodeT u nid k rpkt tp m ()
stopNodeT :: NodeT u nid k rpkt tp m ()
stopNodeT = do
  TVar Bool
st <- (NodeEnv u nid k rpkt -> TVar Bool)
-> NodeT u nid k rpkt tp m (TVar Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv u nid k rpkt -> TVar Bool
forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Bool
nodeStatus
  STM () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> NodeT u nid k rpkt tp m ())
-> STM () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
st Bool
False
  ConnT tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn ConnT tp m ()
forall (m :: * -> *) tp. (MonadIO m, Transport tp) => ConnT tp m ()
close

env :: Monad m => NodeT u nid k rpkt tp m u
env :: NodeT u nid k rpkt tp m u
env = (NodeEnv u nid k rpkt -> u) -> NodeT u nid k rpkt tp m u
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv u nid k rpkt -> u
forall u nid k rpkt. NodeEnv u nid k rpkt -> u
uEnv

request
  :: (MonadUnliftIO m, Transport tp, SendPacket spkt, SetPacketId k spkt, Eq k, Hashable k)
  => Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request :: Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request Maybe Int64
sTout = Maybe Int64
-> Maybe Int -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt, Eq k, Hashable k) =>
Maybe Int64
-> Maybe Int -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
requestAndRetry Maybe Int64
sTout Maybe Int
forall a. Maybe a
Nothing

requestAndRetry
  :: (MonadUnliftIO m, Transport tp, SendPacket spkt, SetPacketId k spkt, Eq k, Hashable k)
  => Maybe Int64 -> Maybe Int -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
requestAndRetry :: Maybe Int64
-> Maybe Int -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
requestAndRetry Maybe Int64
sTout Maybe Int
retryTout spkt
spkt = do
  Bool
alive <- NodeT u nid k rpkt tp m Bool
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
NodeT u nid k rpkt tp m Bool
nodeState
  if Bool
alive then
    Maybe Int64
-> SessionT u nid k rpkt tp m (Maybe rpkt)
-> NodeT u nid k rpkt tp m (Maybe rpkt)
forall (m :: * -> *) k u nid rpkt tp a.
(MonadUnliftIO m, Eq k, Hashable k) =>
Maybe Int64
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
withSessionT Maybe Int64
sTout (SessionT u nid k rpkt tp m (Maybe rpkt)
 -> NodeT u nid k rpkt tp m (Maybe rpkt))
-> SessionT u nid k rpkt tp m (Maybe rpkt)
-> NodeT u nid k rpkt tp m (Maybe rpkt)
forall a b. (a -> b) -> a -> b
$ do
      spkt -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
S.send spkt
spkt
      Maybe (Async Any)
t <- Maybe Int
-> (Int -> SessionT u nid k rpkt tp m (Async Any))
-> SessionT u nid k rpkt tp m (Maybe (Async Any))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Int
retryTout ((Int -> SessionT u nid k rpkt tp m (Async Any))
 -> SessionT u nid k rpkt tp m (Maybe (Async Any)))
-> (Int -> SessionT u nid k rpkt tp m (Async Any))
-> SessionT u nid k rpkt tp m (Maybe (Async Any))
forall a b. (a -> b) -> a -> b
$ \Int
tout ->
        SessionT u nid k rpkt tp m Any
-> SessionT u nid k rpkt tp m (Async Any)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (SessionT u nid k rpkt tp m Any
 -> SessionT u nid k rpkt tp m (Async Any))
-> SessionT u nid k rpkt tp m Any
-> SessionT u nid k rpkt tp m (Async Any)
forall a b. (a -> b) -> a -> b
$ SessionT u nid k rpkt tp m () -> SessionT u nid k rpkt tp m Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (SessionT u nid k rpkt tp m () -> SessionT u nid k rpkt tp m Any)
-> SessionT u nid k rpkt tp m () -> SessionT u nid k rpkt tp m Any
forall a b. (a -> b) -> a -> b
$ do
          Int -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> SessionT u nid k rpkt tp m ())
-> Int -> SessionT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ Int
tout Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
          spkt -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
S.send spkt
spkt
      Maybe rpkt
ret <- SessionT u nid k rpkt tp m (Maybe rpkt)
forall (m :: * -> *) tp u nid k rpkt.
(MonadIO m, Transport tp) =>
SessionT u nid k rpkt tp m (Maybe rpkt)
S.receive
      (Async Any -> SessionT u nid k rpkt tp m ())
-> Maybe (Async Any) -> SessionT u nid k rpkt tp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async Any -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Maybe (Async Any)
t
      Maybe rpkt -> SessionT u nid k rpkt tp m (Maybe rpkt)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe rpkt
ret


  else Maybe rpkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe rpkt
forall a. Maybe a
Nothing

getTimer :: MonadIO m => NodeT u nid k rpkt tp m Int64
getTimer :: NodeT u nid k rpkt tp m Int64
getTimer = TVar Int64 -> NodeT u nid k rpkt tp m Int64
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar Int64 -> NodeT u nid k rpkt tp m Int64)
-> NodeT u nid k rpkt tp m (TVar Int64)
-> NodeT u nid k rpkt tp m Int64
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (NodeEnv u nid k rpkt -> TVar Int64)
-> NodeT u nid k rpkt tp m (TVar Int64)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv u nid k rpkt -> TVar Int64
forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
nodeTimer

setTimer :: MonadIO m => Int64 -> NodeT u nid k rpkt tp m ()
setTimer :: Int64 -> NodeT u nid k rpkt tp m ()
setTimer Int64
t = do
  TVar Int64
v <- (NodeEnv u nid k rpkt -> TVar Int64)
-> NodeT u nid k rpkt tp m (TVar Int64)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv u nid k rpkt -> TVar Int64
forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
nodeTimer
  STM () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> NodeT u nid k rpkt tp m ())
-> STM () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ TVar Int64 -> Int64 -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int64
v Int64
t

getNodeId :: Monad m => NodeT n nid k rpkt tp m nid
getNodeId :: NodeT n nid k rpkt tp m nid
getNodeId = (NodeEnv n nid k rpkt -> nid) -> NodeT n nid k rpkt tp m nid
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv n nid k rpkt -> nid
forall u nid k rpkt. NodeEnv u nid k rpkt -> nid
nodeId

runCheckSessionState :: (MonadUnliftIO m, Eq k, Hashable k) => NodeT u nid k rpkt tp m (Async ())
runCheckSessionState :: NodeT u nid k rpkt tp m (Async ())
runCheckSessionState = do
  IOHashMap k (SessionEnv u nid k rpkt)
sessList <- (NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt))
-> NodeT u nid k rpkt tp m (IOHashMap k (SessionEnv u nid k rpkt))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
forall u nid k rpkt.
NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
sessionList
  NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m (Async ()))
-> (NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ())
-> NodeT u nid k rpkt tp m ()
-> NodeT u nid k rpkt tp m (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m (Async ()))
-> NodeT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m (Async ())
forall a b. (a -> b) -> a -> b
$ do
    Int -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> NodeT u nid k rpkt tp m ())
-> Int -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10  -- 10 seconds
    (SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ())
-> [SessionEnv u nid k rpkt] -> NodeT u nid k rpkt tp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IOHashMap k (SessionEnv u nid k rpkt)
-> SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) k u nid rpkt tp.
(MonadUnliftIO m, Eq k, Hashable k) =>
IOHashMap k (SessionEnv u nid k rpkt)
-> SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
checkAlive IOHashMap k (SessionEnv u nid k rpkt)
sessList) ([SessionEnv u nid k rpkt] -> NodeT u nid k rpkt tp m ())
-> NodeT u nid k rpkt tp m [SessionEnv u nid k rpkt]
-> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IOHashMap k (SessionEnv u nid k rpkt)
-> NodeT u nid k rpkt tp m [SessionEnv u nid k rpkt]
forall (m :: * -> *) k v. MonadIO m => IOHashMap k v -> m [v]
HM.elems IOHashMap k (SessionEnv u nid k rpkt)
sessList

  where checkAlive
          :: (MonadUnliftIO m, Eq k, Hashable k)
          => IOHashMap k (SessionEnv u nid k rpkt) -> SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
        checkAlive :: IOHashMap k (SessionEnv u nid k rpkt)
-> SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
checkAlive IOHashMap k (SessionEnv u nid k rpkt)
sessList SessionEnv u nid k rpkt
sessEnv =
          SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall (m :: * -> *) u nid k rpkt tp a.
Monad m =>
SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
runSessionT_ SessionEnv u nid k rpkt
sessEnv (SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ())
-> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ do
            Bool
to <- SessionT u nid k rpkt tp m Bool
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
SessionT u nid k rpkt tp m Bool
isTimeout
            Bool
-> SessionT u nid k rpkt tp m () -> SessionT u nid k rpkt tp m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
to (SessionT u nid k rpkt tp m () -> SessionT u nid k rpkt tp m ())
-> SessionT u nid k rpkt tp m () -> SessionT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ do
              Maybe rpkt -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) rpkt u nid k tp.
MonadIO m =>
Maybe rpkt -> SessionT u nid k rpkt tp m ()
feed Maybe rpkt
forall a. Maybe a
Nothing
              k
-> IOHashMap k (SessionEnv u nid k rpkt)
-> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) k v.
(MonadIO m, Eq k, Hashable k) =>
k -> IOHashMap k v -> m ()
HM.delete (SessionEnv u nid k rpkt -> k
forall u nid k rpkt. SessionEnv u nid k rpkt -> k
sessionId SessionEnv u nid k rpkt
sessEnv) IOHashMap k (SessionEnv u nid k rpkt)
sessList

getSessionSize :: MonadIO m => NodeEnv u nid k rpkt -> m Int
getSessionSize :: NodeEnv u nid k rpkt -> m Int
getSessionSize NodeEnv {u
nid
IO k
TVar Bool
TVar Int64
TVar (Maybe (SessionEnv u nid k rpkt))
TVar (Maybe (u -> IO ()))
IOHashMap k (SessionEnv u nid k rpkt)
SessionMode
NodeMode
onNodeLeave :: TVar (Maybe (u -> IO ()))
sessTimeout :: TVar Int64
nodeId :: nid
nodeTimer :: TVar Int64
sessionGen :: IO k
sessionList :: IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: SessionMode
nodeMode :: NodeMode
nodeStatus :: TVar Bool
uEnv :: u
onNodeLeave :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (u -> IO ()))
sessTimeout :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
nodeId :: forall u nid k rpkt. NodeEnv u nid k rpkt -> nid
nodeTimer :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Int64
sessionGen :: forall u nid k rpkt. NodeEnv u nid k rpkt -> IO k
sessionList :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> IOHashMap k (SessionEnv u nid k rpkt)
nodeSession :: forall u nid k rpkt.
NodeEnv u nid k rpkt -> TVar (Maybe (SessionEnv u nid k rpkt))
sessionMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> SessionMode
nodeMode :: forall u nid k rpkt. NodeEnv u nid k rpkt -> NodeMode
nodeStatus :: forall u nid k rpkt. NodeEnv u nid k rpkt -> TVar Bool
uEnv :: forall u nid k rpkt. NodeEnv u nid k rpkt -> u
..} = IOHashMap k (SessionEnv u nid k rpkt) -> m Int
forall (m :: * -> *) k v. MonadIO m => IOHashMap k v -> m Int
HM.size IOHashMap k (SessionEnv u nid k rpkt)
sessionList

getSessionSize1 :: MonadIO m => NodeEnv1 u nid k rpkt tp -> m Int
getSessionSize1 :: NodeEnv1 u nid k rpkt tp -> m Int
getSessionSize1 NodeEnv1 {ConnEnv tp
NodeEnv u nid k rpkt
connEnv :: ConnEnv tp
nodeEnv :: NodeEnv u nid k rpkt
connEnv :: forall u nid k rpkt tp. NodeEnv1 u nid k rpkt tp -> ConnEnv tp
nodeEnv :: forall u nid k rpkt tp.
NodeEnv1 u nid k rpkt tp -> NodeEnv u nid k rpkt
..} = NodeEnv u nid k rpkt -> m Int
forall (m :: * -> *) u nid k rpkt.
MonadIO m =>
NodeEnv u nid k rpkt -> m Int
getSessionSize NodeEnv u nid k rpkt
nodeEnv