raketka-1.2.0: src/Control/Distributed/Raketka/NewServerInfo.hs

module Control.Distributed.Raketka.NewServerInfo where

import Control.Distributed.Process
  hiding (Message, mask, finally, handleMessage)
import Control.Monad
import Text.Printf
import Control.Concurrent.STM
import Control.Distributed.Raketka.Type.Server
import Control.Distributed.Raketka.Type.Message
import Control.Distributed.Raketka.Process.Send

{- | 'Ping' and 'Pong' handler -}
newServerInfo::Content tag ps s c =>
    tag (Server ps s)
    -> Ping 
    -> ProcessId 
    -> Process ()

newServerInfo server0 ping0 pid0 = do
    say $ printf "%s received %s from %s\n"
            (spid server1)
            (show ping0)
            pid0

    old_pids1 <- la $ readTVar $ servers1
    let old_pids2 = peer_pids old_pids1
    la $ writeTVar servers1 $ onPeerConnected' old_pids1 pid0

    if (ping0 == Ping) then 
        la $ sendRemote server0 pid0 $
               Info Pong $ spid server1
        else pure ()

    -- monitor the new server
    when (pid0 `notElem` old_pids2) $ void $ monitor pid0

    onPeerConnected server0 pid0
    where server1 = untag server0
          servers1 = servers server1