{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

module Metro.Session
  ( SessionEnv (..)
  , SessionEnv1 (..)
  , newSessionEnv
  , SessionT
  , runSessionT
  , runSessionT1
  , send
  , sessionState
  , feed
  , receive
  , readerSize
  , getSessionId
  , getNodeId
  , getSessionEnv1
  , env
  , ident

  , isTimeout

  , makeResponse
  , makeResponse_
  ) where

import           Control.Monad.Reader.Class (MonadReader, ask, asks)
import           Control.Monad.Trans.Class  (MonadTrans (..))
import           Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
import           Data.Int                   (Int64)
import           Metro.Class                (SendPacket, SetPacketId, Transport,
                                             setPacketId)
import           Metro.Conn                 (ConnEnv, ConnT, FromConn (..),
                                             runConnT, statusTVar)
import qualified Metro.Conn                 as Conn (send)
import           Metro.Utils                (getEpochTime)
import           UnliftIO

data SessionEnv u nid k rpkt = SessionEnv
    { SessionEnv u nid k rpkt -> TVar [Maybe rpkt]
sessionData    :: TVar [Maybe rpkt]
    , SessionEnv u nid k rpkt -> nid
sessionNid     :: nid
    , SessionEnv u nid k rpkt -> k
sessionId      :: k
    , SessionEnv u nid k rpkt -> u
sessionUEnv    :: u
    , SessionEnv u nid k rpkt -> TVar Int64
sessionTimer   :: TVar Int64
    , SessionEnv u nid k rpkt -> Int64
sessionTimeout :: Int64
    }

data SessionEnv1 u nid k rpkt tp = SessionEnv1
    { SessionEnv1 u nid k rpkt tp -> SessionEnv u nid k rpkt
sessionEnv :: SessionEnv u nid k rpkt
    , SessionEnv1 u nid k rpkt tp -> ConnEnv tp
connEnv    :: ConnEnv tp
    }

newSessionEnv :: MonadIO m => u -> nid -> k -> Int64 -> [Maybe rpkt] -> m (SessionEnv u nid k rpkt)
newSessionEnv :: u
-> nid -> k -> Int64 -> [Maybe rpkt] -> m (SessionEnv u nid k rpkt)
newSessionEnv sessionUEnv :: u
sessionUEnv sessionNid :: nid
sessionNid sessionId :: k
sessionId sessionTimeout :: Int64
sessionTimeout rpkts :: [Maybe rpkt]
rpkts = do
  TVar [Maybe rpkt]
sessionData <- [Maybe rpkt] -> m (TVar [Maybe rpkt])
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO [Maybe rpkt]
rpkts
  TVar Int64
sessionTimer <- 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
  SessionEnv u nid k rpkt -> m (SessionEnv u nid k rpkt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SessionEnv :: forall u nid k rpkt.
TVar [Maybe rpkt]
-> nid -> k -> u -> TVar Int64 -> Int64 -> SessionEnv u nid k rpkt
SessionEnv {..}

newtype SessionT u nid k rpkt tp m a = SessionT { SessionT u nid k rpkt tp m a
-> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
unSessionT :: ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a }
  deriving (a -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
(a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
(forall a b.
 (a -> b)
 -> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b)
-> (forall a b.
    a -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a)
-> Functor (SessionT u nid k rpkt tp m)
forall a b.
a -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
forall a b.
(a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a b.
Functor m =>
a -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT 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 -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
$c<$ :: forall u nid k rpkt tp (m :: * -> *) a b.
Functor m =>
a -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
fmap :: (a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
$cfmap :: forall u nid k rpkt tp (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
Functor, Functor (SessionT u nid k rpkt tp m)
a -> SessionT u nid k rpkt tp m a
Functor (SessionT u nid k rpkt tp m) =>
(forall a. a -> SessionT u nid k rpkt tp m a)
-> (forall a b.
    SessionT u nid k rpkt tp m (a -> b)
    -> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b)
-> (forall a b c.
    (a -> b -> c)
    -> SessionT u nid k rpkt tp m a
    -> SessionT u nid k rpkt tp m b
    -> SessionT u nid k rpkt tp m c)
-> (forall a b.
    SessionT u nid k rpkt tp m a
    -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b)
-> (forall a b.
    SessionT u nid k rpkt tp m a
    -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a)
-> Applicative (SessionT u nid k rpkt tp m)
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
SessionT u nid k rpkt tp m (a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
(a -> b -> c)
-> SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b
-> SessionT u nid k rpkt tp m c
forall a. a -> SessionT u nid k rpkt tp m a
forall a b.
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
forall a b.
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
forall a b.
SessionT u nid k rpkt tp m (a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
forall a b c.
(a -> b -> c)
-> SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b
-> SessionT u nid k rpkt tp m c
forall u nid k rpkt tp (m :: * -> *).
Applicative m =>
Functor (SessionT u nid k rpkt tp m)
forall u nid k rpkt tp (m :: * -> *) a.
Applicative m =>
a -> SessionT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
SessionT u nid k rpkt tp m (a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b
-> SessionT 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
<* :: SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
$c<* :: forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m a
*> :: SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
$c*> :: forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
liftA2 :: (a -> b -> c)
-> SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b
-> SessionT u nid k rpkt tp m c
$cliftA2 :: forall u nid k rpkt tp (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b
-> SessionT u nid k rpkt tp m c
<*> :: SessionT u nid k rpkt tp m (a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
$c<*> :: forall u nid k rpkt tp (m :: * -> *) a b.
Applicative m =>
SessionT u nid k rpkt tp m (a -> b)
-> SessionT u nid k rpkt tp m a -> SessionT u nid k rpkt tp m b
pure :: a -> SessionT u nid k rpkt tp m a
$cpure :: forall u nid k rpkt tp (m :: * -> *) a.
Applicative m =>
a -> SessionT u nid k rpkt tp m a
$cp1Applicative :: forall u nid k rpkt tp (m :: * -> *).
Applicative m =>
Functor (SessionT u nid k rpkt tp m)
Applicative, Applicative (SessionT u nid k rpkt tp m)
a -> SessionT u nid k rpkt tp m a
Applicative (SessionT u nid k rpkt tp m) =>
(forall a b.
 SessionT u nid k rpkt tp m a
 -> (a -> SessionT u nid k rpkt tp m b)
 -> SessionT u nid k rpkt tp m b)
-> (forall a b.
    SessionT u nid k rpkt tp m a
    -> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b)
-> (forall a. a -> SessionT u nid k rpkt tp m a)
-> Monad (SessionT u nid k rpkt tp m)
SessionT u nid k rpkt tp m a
-> (a -> SessionT u nid k rpkt tp m b)
-> SessionT u nid k rpkt tp m b
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
forall a. a -> SessionT u nid k rpkt tp m a
forall a b.
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
forall a b.
SessionT u nid k rpkt tp m a
-> (a -> SessionT u nid k rpkt tp m b)
-> SessionT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *).
Monad m =>
Applicative (SessionT u nid k rpkt tp m)
forall u nid k rpkt tp (m :: * -> *) a.
Monad m =>
a -> SessionT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a b.
Monad m =>
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a b.
Monad m =>
SessionT u nid k rpkt tp m a
-> (a -> SessionT u nid k rpkt tp m b)
-> SessionT 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 -> SessionT u nid k rpkt tp m a
$creturn :: forall u nid k rpkt tp (m :: * -> *) a.
Monad m =>
a -> SessionT u nid k rpkt tp m a
>> :: SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
$c>> :: forall u nid k rpkt tp (m :: * -> *) a b.
Monad m =>
SessionT u nid k rpkt tp m a
-> SessionT u nid k rpkt tp m b -> SessionT u nid k rpkt tp m b
>>= :: SessionT u nid k rpkt tp m a
-> (a -> SessionT u nid k rpkt tp m b)
-> SessionT u nid k rpkt tp m b
$c>>= :: forall u nid k rpkt tp (m :: * -> *) a b.
Monad m =>
SessionT u nid k rpkt tp m a
-> (a -> SessionT u nid k rpkt tp m b)
-> SessionT u nid k rpkt tp m b
$cp1Monad :: forall u nid k rpkt tp (m :: * -> *).
Monad m =>
Applicative (SessionT u nid k rpkt tp m)
Monad, Monad (SessionT u nid k rpkt tp m)
Monad (SessionT u nid k rpkt tp m) =>
(forall a. IO a -> SessionT u nid k rpkt tp m a)
-> MonadIO (SessionT u nid k rpkt tp m)
IO a -> SessionT u nid k rpkt tp m a
forall a. IO a -> SessionT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *).
MonadIO m =>
Monad (SessionT u nid k rpkt tp m)
forall u nid k rpkt tp (m :: * -> *) a.
MonadIO m =>
IO a -> SessionT u nid k rpkt tp m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SessionT u nid k rpkt tp m a
$cliftIO :: forall u nid k rpkt tp (m :: * -> *) a.
MonadIO m =>
IO a -> SessionT u nid k rpkt tp m a
$cp1MonadIO :: forall u nid k rpkt tp (m :: * -> *).
MonadIO m =>
Monad (SessionT u nid k rpkt tp m)
MonadIO, MonadReader (SessionEnv u nid k rpkt))

instance MonadTrans (SessionT u nid k rpkt tp) where
  lift :: m a -> SessionT u nid k rpkt tp m a
lift = ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
-> SessionT u nid k rpkt tp m a
forall u nid k rpkt tp (m :: * -> *) a.
ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
-> SessionT u nid k rpkt tp m a
SessionT (ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
 -> SessionT u nid k rpkt tp m a)
-> (m a -> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a)
-> m a
-> SessionT u nid k rpkt tp m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnT tp m a -> ReaderT (SessionEnv 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 (SessionEnv u nid k rpkt) (ConnT tp m) a)
-> (m a -> ConnT tp m a)
-> m a
-> ReaderT (SessionEnv 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 MonadUnliftIO m => MonadUnliftIO (SessionT u nid k rpkt tp m) where
  withRunInIO :: ((forall a. SessionT u nid k rpkt tp m a -> IO a) -> IO b)
-> SessionT u nid k rpkt tp m b
withRunInIO inner :: (forall a. SessionT u nid k rpkt tp m a -> IO a) -> IO b
inner = ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) b
-> SessionT u nid k rpkt tp m b
forall u nid k rpkt tp (m :: * -> *) a.
ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
-> SessionT u nid k rpkt tp m a
SessionT (ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) b
 -> SessionT u nid k rpkt tp m b)
-> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) b
-> SessionT u nid k rpkt tp m b
forall a b. (a -> b) -> a -> b
$
    (SessionEnv u nid k rpkt -> ConnT tp m b)
-> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SessionEnv u nid k rpkt -> ConnT tp m b)
 -> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) b)
-> (SessionEnv u nid k rpkt -> ConnT tp m b)
-> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) b
forall a b. (a -> b) -> a -> b
$ \r :: SessionEnv 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. SessionT 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)
-> (SessionT u nid k rpkt tp m a -> ConnT tp m a)
-> SessionT u nid k rpkt tp m a
-> IO 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
r)

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

runSessionT :: SessionEnv u nid k rpkt -> SessionT u nid k rpkt tp m a -> ConnT tp m a
runSessionT :: SessionEnv u nid k rpkt
-> SessionT u nid k rpkt tp m a -> ConnT tp m a
runSessionT aEnv :: SessionEnv u nid k rpkt
aEnv = (ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
 -> SessionEnv u nid k rpkt -> ConnT tp m a)
-> SessionEnv u nid k rpkt
-> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
-> ConnT tp m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
-> SessionEnv u nid k rpkt -> ConnT tp m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT SessionEnv u nid k rpkt
aEnv (ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a -> ConnT tp m a)
-> (SessionT u nid k rpkt tp m a
    -> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a)
-> SessionT u nid k rpkt tp m a
-> ConnT tp m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionT u nid k rpkt tp m a
-> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
forall u nid k rpkt tp (m :: * -> *) a.
SessionT u nid k rpkt tp m a
-> ReaderT (SessionEnv u nid k rpkt) (ConnT tp m) a
unSessionT

runSessionT1 :: SessionEnv1 u nid k rpkt tp -> SessionT u nid k rpkt tp m a -> m a
runSessionT1 :: SessionEnv1 u nid k rpkt tp -> SessionT u nid k rpkt tp m a -> m a
runSessionT1 SessionEnv1 {..} = 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)
-> (SessionT u nid k rpkt tp m a -> ConnT tp m a)
-> SessionT u nid k rpkt tp m a
-> 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
sessionEnv

sessionState :: MonadIO m => SessionT u nid k rpkt tp m Bool
sessionState :: SessionT u nid k rpkt tp m Bool
sessionState = TVar Bool -> SessionT u nid k rpkt tp m Bool
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar Bool -> SessionT u nid k rpkt tp m Bool)
-> SessionT u nid k rpkt tp m (TVar Bool)
-> SessionT u nid k rpkt tp m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConnT tp m (TVar Bool) -> SessionT u nid k rpkt tp m (TVar Bool)
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn ConnT tp m (TVar Bool)
forall (m :: * -> *) tp. Monad m => ConnT tp m (TVar Bool)
statusTVar

send
  :: (MonadUnliftIO m, Transport tp, SendPacket spkt, SetPacketId k spkt)
  => spkt -> SessionT u nid k rpkt tp m ()
send :: spkt -> SessionT u nid k rpkt tp m ()
send rpkt :: spkt
rpkt = do
  k
mid <- SessionT u nid k rpkt tp m k
forall (m :: * -> *) u nid k rpkt tp.
Monad m =>
SessionT u nid k rpkt tp m k
getSessionId
  ConnT tp m () -> SessionT 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 () -> SessionT u nid k rpkt tp m ())
-> ConnT tp m () -> SessionT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ spkt -> ConnT tp m ()
forall (m :: * -> *) tp pkt.
(MonadUnliftIO m, Transport tp, SendPacket pkt) =>
pkt -> ConnT tp m ()
Conn.send (spkt -> ConnT tp m ()) -> spkt -> ConnT tp m ()
forall a b. (a -> b) -> a -> b
$ k -> spkt -> spkt
forall k pkt. SetPacketId k pkt => k -> pkt -> pkt
setPacketId k
mid spkt
rpkt

feed :: (MonadIO m) => Maybe rpkt -> SessionT u nid k rpkt tp m ()
feed :: Maybe rpkt -> SessionT u nid k rpkt tp m ()
feed rpkt :: Maybe rpkt
rpkt = do
  TVar [Maybe rpkt]
reader <- (SessionEnv u nid k rpkt -> TVar [Maybe rpkt])
-> SessionT u nid k rpkt tp m (TVar [Maybe rpkt])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionEnv u nid k rpkt -> TVar [Maybe rpkt]
forall u nid k rpkt. SessionEnv u nid k rpkt -> TVar [Maybe rpkt]
sessionData
  Int64 -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
Int64 -> SessionT u nid k rpkt tp m ()
setTimer (Int64 -> SessionT u nid k rpkt tp m ())
-> SessionT u nid k rpkt tp m Int64
-> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SessionT u nid k rpkt tp m Int64
forall (m :: * -> *). MonadIO m => m Int64
getEpochTime
  STM () -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> SessionT u nid k rpkt tp m ())
-> (([Maybe rpkt] -> [Maybe rpkt]) -> STM ())
-> ([Maybe rpkt] -> [Maybe rpkt])
-> SessionT u nid k rpkt tp m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar [Maybe rpkt] -> ([Maybe rpkt] -> [Maybe rpkt]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [Maybe rpkt]
reader (([Maybe rpkt] -> [Maybe rpkt]) -> SessionT u nid k rpkt tp m ())
-> ([Maybe rpkt] -> [Maybe rpkt]) -> SessionT u nid k rpkt tp m ()
forall a b. (a -> b) -> a -> b
$ \v :: [Maybe rpkt]
v -> [Maybe rpkt]
v [Maybe rpkt] -> [Maybe rpkt] -> [Maybe rpkt]
forall a. [a] -> [a] -> [a]
++ [Maybe rpkt
rpkt]

receive :: (MonadIO m, Transport tp) => SessionT u nid k rpkt tp m (Maybe rpkt)
receive :: SessionT u nid k rpkt tp m (Maybe rpkt)
receive = do
  TVar [Maybe rpkt]
reader <- (SessionEnv u nid k rpkt -> TVar [Maybe rpkt])
-> SessionT u nid k rpkt tp m (TVar [Maybe rpkt])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionEnv u nid k rpkt -> TVar [Maybe rpkt]
forall u nid k rpkt. SessionEnv u nid k rpkt -> TVar [Maybe rpkt]
sessionData
  TVar Bool
st <- ConnT tp m (TVar Bool) -> SessionT u nid k rpkt tp m (TVar Bool)
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn ConnT tp m (TVar Bool)
forall (m :: * -> *) tp. Monad m => ConnT tp m (TVar Bool)
statusTVar
  STM (Maybe rpkt) -> SessionT u nid k rpkt tp m (Maybe rpkt)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe rpkt) -> SessionT u nid k rpkt tp m (Maybe rpkt))
-> STM (Maybe rpkt) -> SessionT u nid k rpkt tp m (Maybe rpkt)
forall a b. (a -> b) -> a -> b
$ do
    [Maybe rpkt]
v <- TVar [Maybe rpkt] -> STM [Maybe rpkt]
forall a. TVar a -> STM a
readTVar TVar [Maybe rpkt]
reader
    if [Maybe rpkt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe rpkt]
v then do
      Bool
s <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
st
      if Bool
s then STM (Maybe rpkt)
forall a. STM a
retrySTM
           else Maybe rpkt -> STM (Maybe rpkt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe rpkt
forall a. Maybe a
Nothing
    else do
      TVar [Maybe rpkt] -> [Maybe rpkt] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [Maybe rpkt]
reader ([Maybe rpkt] -> STM ()) -> [Maybe rpkt] -> STM ()
forall a b. (a -> b) -> a -> b
$! [Maybe rpkt] -> [Maybe rpkt]
forall a. [a] -> [a]
tail [Maybe rpkt]
v
      Maybe rpkt -> STM (Maybe rpkt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe rpkt -> STM (Maybe rpkt)) -> Maybe rpkt -> STM (Maybe rpkt)
forall a b. (a -> b) -> a -> b
$ [Maybe rpkt] -> Maybe rpkt
forall a. [a] -> a
head [Maybe rpkt]
v

readerSize :: MonadIO m => SessionT u nid k rpkt tp m Int
readerSize :: SessionT u nid k rpkt tp m Int
readerSize = ([Maybe rpkt] -> Int)
-> SessionT u nid k rpkt tp m [Maybe rpkt]
-> SessionT u nid k rpkt tp m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe rpkt] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SessionT u nid k rpkt tp m [Maybe rpkt]
 -> SessionT u nid k rpkt tp m Int)
-> SessionT u nid k rpkt tp m [Maybe rpkt]
-> SessionT u nid k rpkt tp m Int
forall a b. (a -> b) -> a -> b
$ TVar [Maybe rpkt] -> SessionT u nid k rpkt tp m [Maybe rpkt]
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar [Maybe rpkt] -> SessionT u nid k rpkt tp m [Maybe rpkt])
-> SessionT u nid k rpkt tp m (TVar [Maybe rpkt])
-> SessionT u nid k rpkt tp m [Maybe rpkt]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SessionEnv u nid k rpkt -> TVar [Maybe rpkt])
-> SessionT u nid k rpkt tp m (TVar [Maybe rpkt])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionEnv u nid k rpkt -> TVar [Maybe rpkt]
forall u nid k rpkt. SessionEnv u nid k rpkt -> TVar [Maybe rpkt]
sessionData

getSessionId :: Monad m => SessionT u nid k rpkt tp m k
getSessionId :: SessionT u nid k rpkt tp m k
getSessionId = (SessionEnv u nid k rpkt -> k) -> SessionT u nid k rpkt tp m k
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionEnv u nid k rpkt -> k
forall u nid k rpkt. SessionEnv u nid k rpkt -> k
sessionId

getNodeId :: Monad m => SessionT u nid k rpkt tp m nid
getNodeId :: SessionT u nid k rpkt tp m nid
getNodeId = (SessionEnv u nid k rpkt -> nid) -> SessionT u nid k rpkt tp m nid
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionEnv u nid k rpkt -> nid
forall u nid k rpkt. SessionEnv u nid k rpkt -> nid
sessionNid

env :: Monad m => SessionT u nid k rpkt tp m u
env :: SessionT u nid k rpkt tp m u
env = (SessionEnv u nid k rpkt -> u) -> SessionT u nid k rpkt tp m u
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionEnv u nid k rpkt -> u
forall u nid k rpkt. SessionEnv u nid k rpkt -> u
sessionUEnv

-- makeResponse if Nothing ignore
makeResponse
  :: (MonadUnliftIO m, Transport tp, SendPacket spkt, SetPacketId k spkt)
  => (rpkt -> m (Maybe spkt)) -> SessionT u nid k rpkt tp m ()
makeResponse :: (rpkt -> m (Maybe spkt)) -> SessionT u nid k rpkt tp m ()
makeResponse f :: rpkt -> m (Maybe spkt)
f = (rpkt -> SessionT u nid k rpkt tp m ())
-> Maybe rpkt -> SessionT u nid k rpkt tp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ rpkt -> SessionT u nid k rpkt tp m ()
doSend (Maybe rpkt -> SessionT u nid k rpkt tp m ())
-> SessionT u nid k rpkt tp m (Maybe rpkt)
-> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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)
receive

  where doSend :: rpkt -> SessionT u nid k rpkt tp m ()
doSend spkt :: rpkt
spkt = (spkt -> SessionT u nid k rpkt tp m ())
-> Maybe spkt -> SessionT u nid k rpkt tp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 ()
send (Maybe spkt -> SessionT u nid k rpkt tp m ())
-> SessionT u nid k rpkt tp m (Maybe spkt)
-> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (m (Maybe spkt) -> SessionT u nid k rpkt tp m (Maybe spkt)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe spkt) -> SessionT u nid k rpkt tp m (Maybe spkt))
-> (rpkt -> m (Maybe spkt))
-> rpkt
-> SessionT u nid k rpkt tp m (Maybe spkt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rpkt -> m (Maybe spkt)
f) rpkt
spkt

makeResponse_
  :: (MonadUnliftIO m, Transport tp, SendPacket spkt, SetPacketId k spkt)
  => (rpkt -> Maybe spkt) -> SessionT u nid k rpkt tp m ()
makeResponse_ :: (rpkt -> Maybe spkt) -> SessionT u nid k rpkt tp m ()
makeResponse_ f :: rpkt -> Maybe spkt
f = (rpkt -> m (Maybe spkt)) -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) tp spkt k rpkt u nid.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt) =>
(rpkt -> m (Maybe spkt)) -> SessionT u nid k rpkt tp m ()
makeResponse (Maybe spkt -> m (Maybe spkt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe spkt -> m (Maybe spkt))
-> (rpkt -> Maybe spkt) -> rpkt -> m (Maybe spkt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rpkt -> Maybe spkt
f)

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

setTimer :: MonadIO m => Int64 -> SessionT u nid k rpkt tp m ()
setTimer :: Int64 -> SessionT u nid k rpkt tp m ()
setTimer t :: Int64
t = do
  TVar Int64
v <- (SessionEnv u nid k rpkt -> TVar Int64)
-> SessionT u nid k rpkt tp m (TVar Int64)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionEnv u nid k rpkt -> TVar Int64
forall u nid k rpkt. SessionEnv u nid k rpkt -> TVar Int64
sessionTimer
  STM () -> SessionT u nid k rpkt tp m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> SessionT u nid k rpkt tp m ())
-> STM () -> SessionT 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

isTimeout :: MonadIO m => SessionT u nid k rpkt tp m Bool
isTimeout :: SessionT u nid k rpkt tp m Bool
isTimeout = do
  Int64
t <- SessionT u nid k rpkt tp m Int64
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
SessionT u nid k rpkt tp m Int64
getTimer
  Int64
tout <- (SessionEnv u nid k rpkt -> Int64)
-> SessionT u nid k rpkt tp m Int64
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionEnv u nid k rpkt -> Int64
forall u nid k rpkt. SessionEnv u nid k rpkt -> Int64
sessionTimeout
  Int64
now <- SessionT u nid k rpkt tp m Int64
forall (m :: * -> *). MonadIO m => m Int64
getEpochTime
  if Int64
tout Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Bool -> SessionT u nid k rpkt tp m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> SessionT u nid k rpkt tp m Bool)
-> Bool -> SessionT u nid k rpkt tp m Bool
forall a b. (a -> b) -> a -> b
$ (Int64
t Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
tout) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
now
              else Bool -> SessionT u nid k rpkt tp m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

getSessionEnv1 :: (Monad m, Transport tp) => SessionT u nid k rpkt tp m (SessionEnv1 u nid k rpkt tp)
getSessionEnv1 :: SessionT u nid k rpkt tp m (SessionEnv1 u nid k rpkt tp)
getSessionEnv1 = do
  ConnEnv tp
connEnv <- ConnT tp m (ConnEnv tp) -> SessionT 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
  SessionEnv u nid k rpkt
sessionEnv <- SessionT u nid k rpkt tp m (SessionEnv u nid k rpkt)
forall r (m :: * -> *). MonadReader r m => m r
ask
  SessionEnv1 u nid k rpkt tp
-> SessionT u nid k rpkt tp m (SessionEnv1 u nid k rpkt tp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SessionEnv1 :: forall u nid k rpkt tp.
SessionEnv u nid k rpkt
-> ConnEnv tp -> SessionEnv1 u nid k rpkt tp
SessionEnv1 {..}

ident :: SessionEnv1 u nid k rpkt tp -> (nid, k)
ident :: SessionEnv1 u nid k rpkt tp -> (nid, k)
ident SessionEnv1 {..} = (SessionEnv u nid k rpkt -> nid
forall u nid k rpkt. SessionEnv u nid k rpkt -> nid
sessionNid SessionEnv u nid k rpkt
sessionEnv, SessionEnv u nid k rpkt -> k
forall u nid k rpkt. SessionEnv u nid k rpkt -> k
sessionId SessionEnv u nid k rpkt
sessionEnv)