metro 0.1.0.2 → 0.1.0.3

raw patch · 3 files changed

+30/−24 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• metro.cabal +2/−2
• src/Metro/Node.hs +9/−7
• src/Metro/Server.hs +19/−15

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 24d5ce7bcac547eb3eeb276c1486b3d82bc04c04fc1805c000dd3d0b3f402547+-- hash: 07882b5a43e7863f722e3718c4a967123818ae24bfb31cadfcfe24c420cb8799  name:           metro-version:        0.1.0.2+version:        0.1.0.3 synopsis:       A simple tcp and udp socket server framework description:    Please see the README on GitHub at <https://github.com/Lupino/metro#readme> category:       Network,Framework

@@ -91,7 +91,7 @@     , sessionGen  :: IO k     , nodeTimer   :: TVar Int64     , nodeId      :: nid-    , sessTimeout :: Int64+    , sessTimeout :: TVar Int64     , onNodeLeave :: TVar (Maybe (u -> IO ()))     } @@ -129,15 +129,15 @@  initEnv :: MonadIO m => u -> nid -> IO k -> m (NodeEnv u nid k rpkt) initEnv uEnv nodeId sessionGen = do-  nodeStatus <- newTVarIO True+  nodeStatus  <- newTVarIO True   nodeSession <- newTVarIO Nothing   sessionList <- newIOHashMap-  nodeTimer <- newTVarIO =<< getEpochTime+  nodeTimer   <- newTVarIO =<< getEpochTime   onNodeLeave <- newTVarIO Nothing+  sessTimeout <- newTVarIO 300   pure NodeEnv     { nodeMode    = Multi     , sessionMode = SingleAction-    , sessTimeout = 300     , ..     } @@ -152,7 +152,7 @@ setSessionMode :: SessionMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt setSessionMode mode nodeEnv = nodeEnv {sessionMode = mode} -setDefaultSessionTimeout :: Int64 -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt+setDefaultSessionTimeout :: TVar Int64 -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt setDefaultSessionTimeout t nodeEnv = nodeEnv { sessTimeout = t }  initEnv1@@ -185,7 +185,8 @@ newSessionEnv :: (MonadIO m, Eq k, Hashable k) => Maybe Int64 -> k -> NodeT u nid k rpkt tp m (SessionEnv u nid k rpkt) newSessionEnv sTout sid = do   NodeEnv{..} <- ask-  sEnv <- S.newSessionEnv uEnv nodeId sid (fromMaybe sessTimeout sTout) []+  dTout <- readTVarIO sessTimeout+  sEnv <- S.newSessionEnv uEnv nodeId sid (fromMaybe dTout sTout) []   case nodeMode of     Single -> atomically $ do       sess <- readTVar nodeSession@@ -255,7 +256,8 @@       runSessionT_ aEnv $ feed $ Just rpkt     Nothing    -> do       let sid = getPacketId rpkt-      sEnv <- S.newSessionEnv uEnv nodeId sid sessTimeout [Just rpkt]+      dTout <- readTVarIO sessTimeout+      sEnv <- S.newSessionEnv uEnv nodeId sid dTout [Just rpkt]       when (sessionMode == MultiAction) $         case nodeMode of           Single -> atomically $ writeTVar nodeSession $ Just sEnv

@@ -64,8 +64,8 @@     , nodeEnvList  :: IOHashMap nid (NodeEnv1 u nid k rpkt tp)     , prepare      :: SID serv -> ConnEnv tp -> IO (Maybe (nid, u))     , gen          :: IO k-    , keepalive    :: Int64-    , defSessTout  :: Int64+    , keepalive    :: TVar Int64 -- client keepalive seconds+    , defSessTout  :: TVar Int64 -- session timeout seconds     , nodeMode     :: NodeMode     , sessionMode  :: SessionMode     , serveName    :: String@@ -106,12 +106,12 @@   serveState  <- newTVarIO True   nodeEnvList <- newIOHashMap   onNodeLeave <- newTVarIO Nothing+  keepalive   <- newTVarIO 0+  defSessTout <- newTVarIO 300   pure ServerEnv     { nodeMode    = Multi     , sessionMode = SingleAction     , serveName   = "Metro"-    , keepalive   = 0-    , defSessTout = 300     , ..     } @@ -128,16 +128,17 @@ setServerName n sEnv = sEnv {serveName = n}  setKeepalive-  :: Int64 -> ServerEnv serv u nid k rpkt tp -> ServerEnv serv u nid k rpkt tp-setKeepalive k sEnv = sEnv {keepalive = k}+  :: MonadIO m => ServerEnv serv u nid k rpkt tp -> Int -> m ()+setKeepalive sEnv =+  atomically . writeTVar (keepalive sEnv) . fromIntegral  setDefaultSessionTimeout-  :: Int64 -> ServerEnv serv u nid k rpkt tp -> ServerEnv serv u nid k rpkt tp-setDefaultSessionTimeout t sEnv = sEnv {defSessTout = t}+  :: MonadIO m => ServerEnv serv u nid k rpkt tp -> Int -> m ()+setDefaultSessionTimeout sEnv =+  atomically . writeTVar (defSessTout sEnv) . fromIntegral  setOnNodeLeave :: MonadIO m => ServerEnv serv u nid k rpkt tp -> (nid -> u -> IO ()) -> m ()-setOnNodeLeave sEnv =-  atomically . writeTVar (onNodeLeave sEnv) . Just+setOnNodeLeave sEnv = atomically . writeTVar (onNodeLeave sEnv) . Just  serveForever   :: (MonadUnliftIO m, Transport tp, Show nid, Eq nid, Hashable nid, Eq k, Hashable k, GetPacketId k rpkt, RecvPacket rpkt, Servable serv)@@ -249,7 +250,7 @@   -> SessionT u nid k rpkt tp m ()   -> m () startServer_ sEnv preprocess sess = do-  when (keepalive sEnv > 0) $ runCheckNodeState (keepalive sEnv) (nodeEnvList sEnv)+  runCheckNodeState (keepalive sEnv) (nodeEnvList sEnv)   runServerT sEnv $ serveForever preprocess sess   liftIO $ servClose $ serveServ sEnv @@ -261,17 +262,20 @@  runCheckNodeState   :: (MonadUnliftIO m, Eq nid, Hashable nid, Transport tp)-  => Int64 -> IOHashMap nid (NodeEnv1 u nid k rpkt tp) -> m ()+  => TVar Int64 -> IOHashMap nid (NodeEnv1 u nid k rpkt tp) -> m () runCheckNodeState alive envList = void . async . forever $ do-  threadDelay $ fromIntegral alive * 1000 * 1000-  mapM_ (checkAlive envList) =<< HM.elems envList+  t <- readTVarIO alive+  when (t > 0) $ do+    threadDelay $ fromIntegral t * 1000 * 1000+    mapM_ (checkAlive envList) =<< HM.elems envList    where checkAlive           :: (MonadUnliftIO m, Eq nid, Hashable nid, Transport tp)           => IOHashMap nid (NodeEnv1 u nid k rpkt tp)           -> NodeEnv1 u nid k rpkt tp -> m ()         checkAlive ref env1 = runNodeT1 env1 $ do-              expiredAt <- (alive +) <$> getTimer+              t <- readTVarIO alive+              expiredAt <- (t +) <$> getTimer               now <- getEpochTime               when (now > expiredAt) $ do                 nid <- getNodeId