{-# 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

  , 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, mzero, void, when)
import           Control.Monad.Reader.Class (MonadReader (ask), asks)
import           Control.Monad.Trans.Class  (MonadTrans (..))
import           Control.Monad.Trans.Maybe  (runMaybeT)
import           Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
import           Data.Hashable
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.IOHashMap            (IOHashMap, newIOHashMap)
import qualified Metro.IOHashMap            as HM (delete, elems, insert,
                                                   lookup, size)
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 -> Int64
sessTimeout :: 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 inner :: (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
$ \r :: 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
$ \run :: 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 nEnv :: 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 -> 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 uEnv :: u
uEnv nodeId :: nid
nodeId sessionGen :: 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 :: * -> *) a b. MonadIO m => m (IOHashMap a b)
newIOHashMap
  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
  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
-> Int64
-> TVar (Maybe (u -> IO ()))
-> NodeEnv u nid k rpkt
NodeEnv
    { nodeMode :: NodeMode
nodeMode    = NodeMode
Multi
    , sessionMode :: SessionMode
sessionMode = SessionMode
SingleAction
    , sessTimeout :: Int64
sessTimeout = 300
    , ..
    }

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
u m :: 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 mode :: NodeMode
mode nodeEnv :: 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 mode :: SessionMode
mode nodeEnv :: NodeEnv u nid k rpkt
nodeEnv = NodeEnv u nid k rpkt
nodeEnv {sessionMode :: SessionMode
sessionMode = SessionMode
mode}

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

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 mapEnv :: NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
mapEnv connEnv :: ConnEnv tp
connEnv uEnv :: u
uEnv nid :: nid
nid gen :: 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 {..}

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 {..}

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_ aEnv :: 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 sTout :: Maybe Int64
sTout sessionT :: 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
$ \sid :: 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 sTout :: Maybe Int64
sTout sid :: k
sid = do
  NodeEnv{..} <- NodeT u nid k rpkt tp m (NodeEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  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
sessTimeout Maybe Int64
sTout) []
  case NodeMode
nodeMode of
    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
        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 _  -> 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
    Multi -> IOHashMap k (SessionEnv u nid k rpkt)
-> k -> SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
forall a (m :: * -> *) b.
(Eq a, Hashable a, MonadIO m) =>
IOHashMap a b -> a -> b -> m ()
HM.insert IOHashMap k (SessionEnv u nid k rpkt)
sessionList k
sid SessionEnv u nid k rpkt
sEnv
  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 mid :: k
mid = do
  NodeEnv{..} <- 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
    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
    Multi  -> IOHashMap k (SessionEnv u nid k rpkt)
-> k -> NodeT u nid k rpkt tp m ()
forall a (m :: * -> *) b.
(Eq a, Hashable a, MonadIO m) =>
IOHashMap a b -> a -> m ()
HM.delete IOHashMap k (SessionEnv u nid k rpkt)
sessionList k
mid

busy :: MonadIO m => NodeT u nid k rpkt tp m Bool
busy :: NodeT u nid k rpkt tp m Bool
busy = do
  NodeEnv{..} <- 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
    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
    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 preprocess :: rpkt -> m Bool
preprocess sessionHandler :: 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 _  -> 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 preprocess :: rpkt -> m Bool
preprocess sessionHandler :: SessionT u nid k rpkt tp m ()
sessionHandler = do
  NodeEnv{..} <- 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
rpkt sessionHandler :: 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 e :: 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 "Metro.Node" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "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
rpkt sessionHandler :: SessionT u nid k rpkt tp m ()
sessionHandler = do
  NodeEnv{..} <- 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
         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
         Multi  -> IOHashMap k (SessionEnv u nid k rpkt)
-> k -> NodeT u nid k rpkt tp m (Maybe (SessionEnv u nid k rpkt))
forall a (m :: * -> *) b.
(Eq a, Hashable a, MonadIO m) =>
IOHashMap a b -> a -> m (Maybe b)
HM.lookup IOHashMap k (SessionEnv u nid k rpkt)
sessionList (k -> NodeT u nid k rpkt tp m (Maybe (SessionEnv u nid k rpkt)))
-> k -> NodeT u nid k rpkt tp m (Maybe (SessionEnv u nid k rpkt))
forall a b. (a -> b) -> a -> b
$ rpkt -> k
forall k pkt. GetPacketId k pkt => pkt -> k
getPacketId rpkt
rpkt
  case Maybe (SessionEnv u nid k rpkt)
v of
    Just aEnv :: 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
    Nothing    -> do
      let sid :: k
sid = rpkt -> k
forall k pkt. GetPacketId k pkt => pkt -> k
getPacketId rpkt
rpkt
      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
sessTimeout [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
          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
          Multi  -> IOHashMap k (SessionEnv u nid k rpkt)
-> k -> SessionEnv u nid k rpkt -> NodeT u nid k rpkt tp m ()
forall a (m :: * -> *) b.
(Eq a, Hashable a, MonadIO m) =>
IOHashMap a b -> a -> b -> m ()
HM.insert IOHashMap k (SessionEnv u nid k rpkt)
sessionList k
sid SessionEnv u nid k rpkt
sEnv
      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
$ \_ ->
        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_ preprocess :: rpkt -> m Bool
preprocess sessionHandler :: 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
  NodeT u nid k rpkt tp m (Maybe Any) -> NodeT u nid k rpkt tp m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (NodeT u nid k rpkt tp m (Maybe Any) -> NodeT u nid k rpkt tp m ())
-> (MaybeT (NodeT u nid k rpkt tp m) ()
    -> NodeT u nid k rpkt tp m (Maybe Any))
-> MaybeT (NodeT u nid k rpkt tp m) ()
-> NodeT u nid k rpkt tp m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT (NodeT u nid k rpkt tp m) Any
-> NodeT u nid k rpkt tp m (Maybe Any)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (NodeT u nid k rpkt tp m) Any
 -> NodeT u nid k rpkt tp m (Maybe Any))
-> (MaybeT (NodeT u nid k rpkt tp m) ()
    -> MaybeT (NodeT u nid k rpkt tp m) Any)
-> MaybeT (NodeT u nid k rpkt tp m) ()
-> NodeT u nid k rpkt tp m (Maybe Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT (NodeT u nid k rpkt tp m) ()
-> MaybeT (NodeT u nid k rpkt tp m) Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (MaybeT (NodeT u nid k rpkt tp m) () -> NodeT u nid k rpkt tp m ())
-> MaybeT (NodeT u nid k rpkt tp m) ()
-> 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
-> MaybeT (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 () -> MaybeT (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 () -> MaybeT (NodeT u nid k rpkt tp m) ())
-> NodeT u nid k rpkt tp m ()
-> MaybeT (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 MaybeT (NodeT u nid k rpkt tp m) ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero

  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 :: * -> *) a b. MonadIO m => IOHashMap a b -> m [b]
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 aEnv :: 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 sTout :: 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 sTout :: Maybe Int64
sTout retryTout :: Maybe Int
retryTout spkt :: 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
$ \tout :: 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
* 1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 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 t :: 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
$ 1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 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 :: * -> *) a b. MonadIO m => IOHashMap a b -> m [b]
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 sessList :: IOHashMap k (SessionEnv u nid k rpkt)
sessList sessEnv :: 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
              IOHashMap k (SessionEnv u nid k rpkt)
-> k -> SessionT u nid k rpkt tp m ()
forall a (m :: * -> *) b.
(Eq a, Hashable a, MonadIO m) =>
IOHashMap a b -> a -> m ()
HM.delete IOHashMap k (SessionEnv u nid k rpkt)
sessList (SessionEnv u nid k rpkt -> k
forall u nid k rpkt. SessionEnv u nid k rpkt -> k
sessionId SessionEnv u nid k rpkt
sessEnv)

getSessionSize :: MonadIO m => NodeEnv u nid k rpkt -> m Int
getSessionSize :: NodeEnv u nid k rpkt -> m Int
getSessionSize NodeEnv {..} = IOHashMap k (SessionEnv u nid k rpkt) -> m Int
forall (m :: * -> *) a b. MonadIO m => IOHashMap a b -> 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 {..} = 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