{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE DeriveLift                 #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}

module Foreign.Erlang.LocalNode
    ( LocalNode()
    , NodeT()
    , LocalNodeConfig(..)
    , askCreation
    , askNodeName
    , askNodeState
    , askNodeRegistration
    , askLocalNode
    , runNodeT
    , make_pid
    , make_ref
    , make_port
    , make_mailbox
    , register_pid
    , send
    , sendReg
    ) where

--    , closeLocalNode
import           Prelude                       hiding ( id )

import           Control.Monad
import           Control.Monad.Reader
import           Control.Concurrent.STM
import           Control.Monad.Base
import qualified Data.ByteString.Char8         as CS
import           Data.Word

import           Util.IOExtra
import           Util.BufferedIOx
import           Util.Socket
import           Network.BufferedSocket

import           Foreign.Erlang.ControlMessage ( ControlMessage(..) )
import           Foreign.Erlang.NodeState
import           Foreign.Erlang.NodeData
import           Foreign.Erlang.Epmd
import           Foreign.Erlang.Handshake
import           Foreign.Erlang.Term
import           Foreign.Erlang.Connection
import           Foreign.Erlang.Mailbox

data LocalNodeConfig = LocalNodeConfig { LocalNodeConfig -> String
aliveName :: String
                                       , LocalNodeConfig -> String
hostName  :: String
                                       , LocalNodeConfig -> String
cookie    :: String
                                       }
    deriving Int -> LocalNodeConfig -> ShowS
[LocalNodeConfig] -> ShowS
LocalNodeConfig -> String
(Int -> LocalNodeConfig -> ShowS)
-> (LocalNodeConfig -> String)
-> ([LocalNodeConfig] -> ShowS)
-> Show LocalNodeConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalNodeConfig] -> ShowS
$cshowList :: [LocalNodeConfig] -> ShowS
show :: LocalNodeConfig -> String
$cshow :: LocalNodeConfig -> String
showsPrec :: Int -> LocalNodeConfig -> ShowS
$cshowsPrec :: Int -> LocalNodeConfig -> ShowS
Show

newtype NodeT m a = NodeT { NodeT m a -> ReaderT RegisteredNode m a
unNodeT :: ReaderT RegisteredNode m a }
    deriving (a -> NodeT m b -> NodeT m a
(a -> b) -> NodeT m a -> NodeT m b
(forall a b. (a -> b) -> NodeT m a -> NodeT m b)
-> (forall a b. a -> NodeT m b -> NodeT m a) -> Functor (NodeT m)
forall a b. a -> NodeT m b -> NodeT m a
forall a b. (a -> b) -> NodeT m a -> NodeT m b
forall (m :: * -> *) a b. Functor m => a -> NodeT m b -> NodeT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NodeT m a -> NodeT 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 m b -> NodeT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> NodeT m b -> NodeT m a
fmap :: (a -> b) -> NodeT m a -> NodeT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NodeT m a -> NodeT m b
Functor, Functor (NodeT m)
a -> NodeT m a
Functor (NodeT m)
-> (forall a. a -> NodeT m a)
-> (forall a b. NodeT m (a -> b) -> NodeT m a -> NodeT m b)
-> (forall a b c.
    (a -> b -> c) -> NodeT m a -> NodeT m b -> NodeT m c)
-> (forall a b. NodeT m a -> NodeT m b -> NodeT m b)
-> (forall a b. NodeT m a -> NodeT m b -> NodeT m a)
-> Applicative (NodeT m)
NodeT m a -> NodeT m b -> NodeT m b
NodeT m a -> NodeT m b -> NodeT m a
NodeT m (a -> b) -> NodeT m a -> NodeT m b
(a -> b -> c) -> NodeT m a -> NodeT m b -> NodeT m c
forall a. a -> NodeT m a
forall a b. NodeT m a -> NodeT m b -> NodeT m a
forall a b. NodeT m a -> NodeT m b -> NodeT m b
forall a b. NodeT m (a -> b) -> NodeT m a -> NodeT m b
forall a b c. (a -> b -> c) -> NodeT m a -> NodeT m b -> NodeT 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
forall (m :: * -> *). Applicative m => Functor (NodeT m)
forall (m :: * -> *) a. Applicative m => a -> NodeT m a
forall (m :: * -> *) a b.
Applicative m =>
NodeT m a -> NodeT m b -> NodeT m a
forall (m :: * -> *) a b.
Applicative m =>
NodeT m a -> NodeT m b -> NodeT m b
forall (m :: * -> *) a b.
Applicative m =>
NodeT m (a -> b) -> NodeT m a -> NodeT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NodeT m a -> NodeT m b -> NodeT m c
<* :: NodeT m a -> NodeT m b -> NodeT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
NodeT m a -> NodeT m b -> NodeT m a
*> :: NodeT m a -> NodeT m b -> NodeT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
NodeT m a -> NodeT m b -> NodeT m b
liftA2 :: (a -> b -> c) -> NodeT m a -> NodeT m b -> NodeT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NodeT m a -> NodeT m b -> NodeT m c
<*> :: NodeT m (a -> b) -> NodeT m a -> NodeT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
NodeT m (a -> b) -> NodeT m a -> NodeT m b
pure :: a -> NodeT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> NodeT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (NodeT m)
Applicative, Applicative (NodeT m)
a -> NodeT m a
Applicative (NodeT m)
-> (forall a b. NodeT m a -> (a -> NodeT m b) -> NodeT m b)
-> (forall a b. NodeT m a -> NodeT m b -> NodeT m b)
-> (forall a. a -> NodeT m a)
-> Monad (NodeT m)
NodeT m a -> (a -> NodeT m b) -> NodeT m b
NodeT m a -> NodeT m b -> NodeT m b
forall a. a -> NodeT m a
forall a b. NodeT m a -> NodeT m b -> NodeT m b
forall a b. NodeT m a -> (a -> NodeT m b) -> NodeT m b
forall (m :: * -> *). Monad m => Applicative (NodeT m)
forall (m :: * -> *) a. Monad m => a -> NodeT m a
forall (m :: * -> *) a b.
Monad m =>
NodeT m a -> NodeT m b -> NodeT m b
forall (m :: * -> *) a b.
Monad m =>
NodeT m a -> (a -> NodeT m b) -> NodeT 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 m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> NodeT m a
>> :: NodeT m a -> NodeT m b -> NodeT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
NodeT m a -> NodeT m b -> NodeT m b
>>= :: NodeT m a -> (a -> NodeT m b) -> NodeT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
NodeT m a -> (a -> NodeT m b) -> NodeT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (NodeT m)
Monad, MonadThrow (NodeT m)
MonadThrow (NodeT m)
-> (forall e a.
    Exception e =>
    NodeT m a -> (e -> NodeT m a) -> NodeT m a)
-> MonadCatch (NodeT m)
NodeT m a -> (e -> NodeT m a) -> NodeT m a
forall e a.
Exception e =>
NodeT m a -> (e -> NodeT m a) -> NodeT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (NodeT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
NodeT m a -> (e -> NodeT m a) -> NodeT m a
catch :: NodeT m a -> (e -> NodeT m a) -> NodeT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
NodeT m a -> (e -> NodeT m a) -> NodeT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (NodeT m)
MonadCatch, Monad (NodeT m)
e -> NodeT m a
Monad (NodeT m)
-> (forall e a. Exception e => e -> NodeT m a)
-> MonadThrow (NodeT m)
forall e a. Exception e => e -> NodeT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (NodeT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> NodeT m a
throwM :: e -> NodeT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> NodeT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (NodeT m)
MonadThrow, MonadCatch (NodeT m)
MonadCatch (NodeT m)
-> (forall b.
    ((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b)
-> (forall b.
    ((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b)
-> (forall a b c.
    NodeT m a
    -> (a -> ExitCase b -> NodeT m c)
    -> (a -> NodeT m b)
    -> NodeT m (b, c))
-> MonadMask (NodeT m)
NodeT m a
-> (a -> ExitCase b -> NodeT m c)
-> (a -> NodeT m b)
-> NodeT m (b, c)
((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b
((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b
forall b.
((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b
forall a b c.
NodeT m a
-> (a -> ExitCase b -> NodeT m c)
-> (a -> NodeT m b)
-> NodeT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (NodeT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b
forall (m :: * -> *) a b c.
MonadMask m =>
NodeT m a
-> (a -> ExitCase b -> NodeT m c)
-> (a -> NodeT m b)
-> NodeT m (b, c)
generalBracket :: NodeT m a
-> (a -> ExitCase b -> NodeT m c)
-> (a -> NodeT m b)
-> NodeT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
NodeT m a
-> (a -> ExitCase b -> NodeT m c)
-> (a -> NodeT m b)
-> NodeT m (b, c)
uninterruptibleMask :: ((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b
mask :: ((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. NodeT m a -> NodeT m a) -> NodeT m b) -> NodeT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (NodeT m)
MonadMask, Monad (NodeT m)
Monad (NodeT m)
-> (forall msg.
    ToLogStr msg =>
    Loc -> LogSource -> LogLevel -> msg -> NodeT m ())
-> MonadLogger (NodeT m)
Loc -> LogSource -> LogLevel -> msg -> NodeT m ()
forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> NodeT m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> LogSource -> LogLevel -> msg -> m ())
-> MonadLogger m
forall (m :: * -> *). MonadLogger m => Monad (NodeT m)
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> NodeT m ()
monadLoggerLog :: Loc -> LogSource -> LogLevel -> msg -> NodeT m ()
$cmonadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> NodeT m ()
$cp1MonadLogger :: forall (m :: * -> *). MonadLogger m => Monad (NodeT m)
MonadLogger, Monad (NodeT m)
Monad (NodeT m)
-> (forall a. IO a -> NodeT m a) -> MonadIO (NodeT m)
IO a -> NodeT m a
forall a. IO a -> NodeT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (NodeT m)
forall (m :: * -> *) a. MonadIO m => IO a -> NodeT m a
liftIO :: IO a -> NodeT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> NodeT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (NodeT m)
MonadIO)

deriving instance (MonadBase IO (NodeT m), MonadResource m) =>
         MonadResource (NodeT m)

deriving instance MonadLoggerIO m => MonadLoggerIO (NodeT m)

deriving instance MonadBase b m => MonadBase b (NodeT m)

instance (MonadBaseControl b m) =>
         MonadBaseControl b (NodeT m) where
    type StM (NodeT m) a = StM m a
    liftBaseWith :: (RunInBase (NodeT m) b -> b a) -> NodeT m a
liftBaseWith RunInBase (NodeT m) b -> b a
k = ReaderT RegisteredNode m a -> NodeT m a
forall (m :: * -> *) a. ReaderT RegisteredNode m a -> NodeT m a
NodeT ((RunInBase (ReaderT RegisteredNode m) b -> b a)
-> ReaderT RegisteredNode m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase (ReaderT RegisteredNode m) b
run -> RunInBase (NodeT m) b -> b a
k (ReaderT RegisteredNode m a -> b (StM m a)
RunInBase (ReaderT RegisteredNode m) b
run (ReaderT RegisteredNode m a -> b (StM m a))
-> (NodeT m a -> ReaderT RegisteredNode m a)
-> NodeT m a
-> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m a -> ReaderT RegisteredNode m a
forall (m :: * -> *) a. NodeT m a -> ReaderT RegisteredNode m a
unNodeT)))
    restoreM :: StM (NodeT m) a -> NodeT m a
restoreM = ReaderT RegisteredNode m a -> NodeT m a
forall (m :: * -> *) a. ReaderT RegisteredNode m a -> NodeT m a
NodeT (ReaderT RegisteredNode m a -> NodeT m a)
-> (StM m a -> ReaderT RegisteredNode m a) -> StM m a -> NodeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> ReaderT RegisteredNode m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM

data LocalNode = LocalNode { LocalNode -> HandshakeData
handshakeData  :: HandshakeData
                           , LocalNode -> NodeState Pid Term Mailbox Connection
nodeState      :: NodeState Pid Term Mailbox Connection
                           , LocalNode -> Socket
acceptorSocket :: Socket
                           }

data RegisteredNode = RegisteredNode { RegisteredNode -> LocalNode
localNode        :: LocalNode
                                     , RegisteredNode -> NodeRegistration
nodeRegistration :: NodeRegistration
                                     }

askLocalNode :: Monad m => NodeT m LocalNode
askLocalNode :: NodeT m LocalNode
askLocalNode = ReaderT RegisteredNode m LocalNode -> NodeT m LocalNode
forall (m :: * -> *) a. ReaderT RegisteredNode m a -> NodeT m a
NodeT ((RegisteredNode -> LocalNode) -> ReaderT RegisteredNode m LocalNode
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RegisteredNode -> LocalNode
localNode)

askNodeRegistration :: Monad m => NodeT m NodeRegistration
askNodeRegistration :: NodeT m NodeRegistration
askNodeRegistration = ReaderT RegisteredNode m NodeRegistration
-> NodeT m NodeRegistration
forall (m :: * -> *) a. ReaderT RegisteredNode m a -> NodeT m a
NodeT ((RegisteredNode -> NodeRegistration)
-> ReaderT RegisteredNode m NodeRegistration
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RegisteredNode -> NodeRegistration
nodeRegistration)

askCreation :: Monad m => NodeT m Word8
askCreation :: NodeT m Word8
askCreation = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8)
-> (NodeRegistration -> Word16) -> NodeRegistration -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeRegistration -> Word16
nr_creation (NodeRegistration -> Word8)
-> NodeT m NodeRegistration -> NodeT m Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeT m NodeRegistration
forall (m :: * -> *). Monad m => NodeT m NodeRegistration
askNodeRegistration

askNodeState :: Monad m => NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState :: NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState = LocalNode -> NodeState Pid Term Mailbox Connection
nodeState (LocalNode -> NodeState Pid Term Mailbox Connection)
-> NodeT m LocalNode
-> NodeT m (NodeState Pid Term Mailbox Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeT m LocalNode
forall (m :: * -> *). Monad m => NodeT m LocalNode
askLocalNode

askNodeName :: Monad m => NodeT m CS.ByteString
askNodeName :: NodeT m ByteString
askNodeName = Name -> ByteString
n_nodeName (Name -> ByteString)
-> (LocalNode -> Name) -> LocalNode -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandshakeData -> Name
name (HandshakeData -> Name)
-> (LocalNode -> HandshakeData) -> LocalNode -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalNode -> HandshakeData
handshakeData (LocalNode -> ByteString)
-> NodeT m LocalNode -> NodeT m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeT m LocalNode
forall (m :: * -> *). Monad m => NodeT m LocalNode
askLocalNode

make_pid :: MonadIO m => NodeT m Pid
make_pid :: NodeT m Pid
make_pid = do
    ByteString
name <- NodeT m ByteString
forall (m :: * -> *). Monad m => NodeT m ByteString
askNodeName
    NodeState Pid Term Mailbox Connection
state <- NodeT m (NodeState Pid Term Mailbox Connection)
forall (m :: * -> *).
Monad m =>
NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState
    (Word32
id, Word32
serial) <- IO (Word32, Word32) -> NodeT m (Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NodeState Pid Term Mailbox Connection -> IO (Word32, Word32)
forall p n mb c. NodeState p n mb c -> IO (Word32, Word32)
new_pid NodeState Pid Term Mailbox Connection
state)
    Word8
cr <- NodeT m Word8
forall (m :: * -> *). Monad m => NodeT m Word8
askCreation
    Pid -> NodeT m Pid
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Word32 -> Word32 -> Word8 -> Pid
pid ByteString
name Word32
id Word32
serial Word8
cr)

register_pid :: (MonadIO m) => Term -> Pid -> NodeT m Bool
register_pid :: Term -> Pid -> NodeT m Bool
register_pid Term
name Pid
pid' = do
    NodeState Pid Term Mailbox Connection
state <- NodeT m (NodeState Pid Term Mailbox Connection)
forall (m :: * -> *).
Monad m =>
NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState
    IO Bool -> NodeT m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
                Maybe Mailbox
mbox <- NodeState Pid Term Mailbox Connection -> Pid -> IO (Maybe Mailbox)
forall p n mb c. Ord p => NodeState p n mb c -> p -> IO (Maybe mb)
getMailboxForPid NodeState Pid Term Mailbox Connection
state Pid
pid'
                (Mailbox -> IO ()) -> Maybe Mailbox -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (NodeState Pid Term Mailbox Connection -> Term -> Mailbox -> IO ()
forall n p mb c. Ord n => NodeState p n mb c -> n -> mb -> IO ()
putMailboxForName NodeState Pid Term Mailbox Connection
state Term
name) Maybe Mailbox
mbox
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Mailbox -> Bool
forall a. Maybe a -> Bool
isJust Maybe Mailbox
mbox))

make_ref :: (MonadIO m) => NodeT m Term
make_ref :: NodeT m Term
make_ref = do
    NodeState Pid Term Mailbox Connection
state <- NodeT m (NodeState Pid Term Mailbox Connection)
forall (m :: * -> *).
Monad m =>
NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState
    ByteString
name <- NodeT m ByteString
forall (m :: * -> *). Monad m => NodeT m ByteString
askNodeName
    (Word32
refId0, Word32
refId1, Word32
refId2) <- IO (Word32, Word32, Word32) -> NodeT m (Word32, Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NodeState Pid Term Mailbox Connection
-> IO (Word32, Word32, Word32)
forall p n mb c. NodeState p n mb c -> IO (Word32, Word32, Word32)
new_ref NodeState Pid Term Mailbox Connection
state)
    Word8
cr <- NodeT m Word8
forall (m :: * -> *). Monad m => NodeT m Word8
askCreation
    Term -> NodeT m Term
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Word8 -> [Word32] -> Term
ref ByteString
name Word8
cr [ Word32
refId0, Word32
refId1, Word32
refId2 ])

make_port :: (MonadIO m) => NodeT m Term
make_port :: NodeT m Term
make_port = do
    ByteString
name <- NodeT m ByteString
forall (m :: * -> *). Monad m => NodeT m ByteString
askNodeName
    NodeState Pid Term Mailbox Connection
state <- NodeT m (NodeState Pid Term Mailbox Connection)
forall (m :: * -> *).
Monad m =>
NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState
    Word32
id <- IO Word32 -> NodeT m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NodeState Pid Term Mailbox Connection -> IO Word32
forall p n mb c. NodeState p n mb c -> IO Word32
new_port NodeState Pid Term Mailbox Connection
state)
    Word8
cr <- NodeT m Word8
forall (m :: * -> *). Monad m => NodeT m Word8
askCreation
    Term -> NodeT m Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> NodeT m Term) -> Term -> NodeT m Term
forall a b. (a -> b) -> a -> b
$ ByteString -> Word32 -> Word8 -> Term
port ByteString
name Word32
id Word8
cr

runNodeT :: forall m a.
         (MonadResource m, MonadThrow m, MonadMask m, MonadLogger m, MonadLoggerIO m, MonadBaseControl IO m)
         => LocalNodeConfig
         -> NodeT m a
         -> m a
runNodeT :: LocalNodeConfig -> NodeT m a -> m a
runNodeT LocalNodeConfig{String
aliveName :: String
$sel:aliveName:LocalNodeConfig :: LocalNodeConfig -> String
aliveName,String
hostName :: String
$sel:hostName:LocalNodeConfig :: LocalNodeConfig -> String
hostName,String
cookie :: String
$sel:cookie:LocalNodeConfig :: LocalNodeConfig -> String
cookie} NodeT{ReaderT RegisteredNode m a
unNodeT :: ReaderT RegisteredNode m a
$sel:unNodeT:NodeT :: forall (m :: * -> *) a. NodeT m a -> ReaderT RegisteredNode m a
unNodeT} = do
    String -> Bool -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLogger m) =>
String -> Bool -> m ()
requireM String
"(aliveName /= \"\")" (String
aliveName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"")
    String -> Bool -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLogger m) =>
String -> Bool -> m ()
requireM String
"(hostName /= \"\")" (String
hostName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"")
    m LocalNode -> (LocalNode -> m ()) -> (LocalNode -> m a) -> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m LocalNode
setupAcceptorSock LocalNode -> m ()
forall (m :: * -> *). MonadIO m => LocalNode -> m ()
stopAllConnections LocalNode -> m a
acceptRegisterAndRun
  where
    setupAcceptorSock :: m LocalNode
setupAcceptorSock = do
        let nodeNameBS :: ByteString
nodeNameBS = String -> ByteString
CS.pack (String
aliveName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
hostName)
        (ReleaseKey
_, (Socket
acceptorSocket, Word16
portNo)) <- IO (Socket, Word16)
-> ((Socket, Word16) -> IO ()) -> m (ReleaseKey, (Socket, Word16))
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (ByteString -> IO (Socket, Word16)
serverSocket (String -> ByteString
CS.pack String
hostName))
                                                  (Socket -> IO ()
closeSock (Socket -> IO ())
-> ((Socket, Word16) -> Socket) -> (Socket, Word16) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket, Word16) -> Socket
forall a b. (a, b) -> a
fst)
        let dFlags :: DistributionFlags
dFlags = [DistributionFlag] -> DistributionFlags
DistributionFlags [ DistributionFlag
EXTENDED_REFERENCES
                                       , DistributionFlag
FUN_TAGS
                                       , DistributionFlag
NEW_FUN_TAGS
                                       , DistributionFlag
EXTENDED_PIDS_PORTS
                                       , DistributionFlag
BIT_BINARIES
                                       , DistributionFlag
NEW_FLOATS
                                       ]
            name :: Name
name = Name :: DistributionVersion -> DistributionFlags -> ByteString -> Name
Name { n_distVer :: DistributionVersion
n_distVer = DistributionVersion
R6B
                        , n_distFlags :: DistributionFlags
n_distFlags = DistributionFlags
dFlags
                        , n_nodeName :: ByteString
n_nodeName = ByteString
nodeNameBS
                        }
            nodeData :: NodeData
nodeData = NodeData :: Word16
-> NodeType
-> NodeProtocol
-> DistributionVersion
-> DistributionVersion
-> ByteString
-> ByteString
-> NodeData
NodeData { portNo :: Word16
portNo = Word16
portNo
                                , nodeType :: NodeType
nodeType = NodeType
HiddenNode
                                , protocol :: NodeProtocol
protocol = NodeProtocol
TcpIpV4
                                , hiVer :: DistributionVersion
hiVer = DistributionVersion
R6B
                                , loVer :: DistributionVersion
loVer = DistributionVersion
R6B
                                , aliveName :: ByteString
aliveName = String -> ByteString
CS.pack String
aliveName
                                , extra :: ByteString
extra = ByteString
""
                                }
            handshakeData :: HandshakeData
handshakeData = HandshakeData :: Name -> NodeData -> ByteString -> HandshakeData
HandshakeData { Name
name :: Name
name :: Name
name
                                          , NodeData
nodeData :: NodeData
nodeData :: NodeData
nodeData
                                          , cookie :: ByteString
cookie = String -> ByteString
CS.pack String
cookie
                                          }
        NodeState Pid Term Mailbox Connection
nodeState <- IO (NodeState Pid Term Mailbox Connection)
-> m (NodeState Pid Term Mailbox Connection)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (NodeState Pid Term Mailbox Connection)
forall p n mb c. IO (NodeState p n mb c)
newNodeState
        LocalNode -> m LocalNode
forall (m :: * -> *) a. Monad m => a -> m a
return LocalNode :: HandshakeData
-> NodeState Pid Term Mailbox Connection -> Socket -> LocalNode
LocalNode { Socket
acceptorSocket :: Socket
$sel:acceptorSocket:LocalNode :: Socket
acceptorSocket, HandshakeData
handshakeData :: HandshakeData
$sel:handshakeData:LocalNode :: HandshakeData
handshakeData, NodeState Pid Term Mailbox Connection
nodeState :: NodeState Pid Term Mailbox Connection
$sel:nodeState:LocalNode :: NodeState Pid Term Mailbox Connection
nodeState }

    acceptRegisterAndRun :: LocalNode -> m a
acceptRegisterAndRun localNode :: LocalNode
localNode@LocalNode{Socket
acceptorSocket :: Socket
$sel:acceptorSocket:LocalNode :: LocalNode -> Socket
acceptorSocket,$sel:handshakeData:LocalNode :: LocalNode -> HandshakeData
handshakeData = hsn :: HandshakeData
hsn@HandshakeData{NodeData
nodeData :: NodeData
nodeData :: HandshakeData -> NodeData
nodeData},NodeState Pid Term Mailbox Connection
nodeState :: NodeState Pid Term Mailbox Connection
$sel:nodeState:LocalNode :: LocalNode -> NodeState Pid Term Mailbox Connection
nodeState} =
        m Any -> (Async (StM m Any) -> m a) -> m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m Any
accept (\Async (StM m Any)
accepted -> Async (StM m Any) -> m ()
forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
link Async (StM m Any)
accepted m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
registerAndRun)
      where
        accept :: m Any
accept = m () -> m Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m BufferedSocket
-> (BufferedSocket -> m ()) -> (BufferedSocket -> m ()) -> m ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadMask m, MonadLogger m) =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnErrorLog (IO BufferedSocket -> m BufferedSocket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Socket -> IO Socket
acceptSocket Socket
acceptorSocket IO Socket -> (Socket -> IO BufferedSocket) -> IO BufferedSocket
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                                         Socket -> IO BufferedSocket
makeBuffered))
                                            (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (BufferedSocket -> IO ()) -> BufferedSocket -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferedSocket -> IO ()
forall a (m :: * -> *). (BufferedIOx a, MonadIO m) => a -> m ()
closeBuffered)
                                            BufferedSocket -> m ()
onConnect)
          where
            onConnect :: BufferedSocket -> m ()
onConnect BufferedSocket
sock = m ByteString -> m (Maybe ByteString)
forall a (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLogger m) =>
m a -> m (Maybe a)
tryAndLogAll ((forall o. Binary o => o -> m ())
-> (forall i. Binary i => m i) -> HandshakeData -> m ByteString
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
(forall o. Binary o => o -> m ())
-> (forall i. Binary i => m i) -> HandshakeData -> m ByteString
doAccept (BufferedSocket -> o -> m ()
forall (m :: * -> *) s a.
(MonadIO m, BufferedIOx s, Binary a) =>
s -> a -> m ()
runPutBuffered BufferedSocket
sock)
                                                    (BufferedSocket -> m i
forall (m :: * -> *) s a.
(MonadIO m, BufferedIOx s, Binary a, MonadMask m, MonadLogger m) =>
s -> m a
runGetBuffered BufferedSocket
sock)
                                                    HandshakeData
hsn)
                m (Maybe ByteString) -> (Maybe ByteString -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m () -> (ByteString -> m ()) -> Maybe ByteString -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                          (m Connection -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Connection -> m ())
-> (ByteString -> m Connection) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferedSocket
-> NodeState Pid Term Mailbox Connection -> Term -> m Connection
forall (m :: * -> *) s.
(MonadLoggerIO m, MonadMask m, MonadBaseControl IO m,
 BufferedIOx s) =>
s -> NodeState Pid Term Mailbox Connection -> Term -> m Connection
newConnection BufferedSocket
sock NodeState Pid Term Mailbox Connection
nodeState (Term -> m Connection)
-> (ByteString -> Term) -> ByteString -> m Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Term
atom)


        registerAndRun :: m a
registerAndRun = NodeData -> ByteString -> (NodeRegistration -> m a) -> m a
forall (m :: * -> *) a.
(MonadResource m, MonadLogger m, MonadMask m) =>
NodeData -> ByteString -> (NodeRegistration -> m a) -> m a
registerNode NodeData
nodeData (String -> ByteString
CS.pack String
hostName) NodeRegistration -> m a
go
          where
            go :: NodeRegistration -> m a
go NodeRegistration
nodeRegistration = do
                let env :: RegisteredNode
env = RegisteredNode :: LocalNode -> NodeRegistration -> RegisteredNode
RegisteredNode { LocalNode
localNode :: LocalNode
$sel:localNode:RegisteredNode :: LocalNode
localNode, NodeRegistration
nodeRegistration :: NodeRegistration
$sel:nodeRegistration:RegisteredNode :: NodeRegistration
nodeRegistration }
                a
result <- ReaderT RegisteredNode m a -> RegisteredNode -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT RegisteredNode m a
unNodeT RegisteredNode
env
                a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

    stopAllConnections :: LocalNode -> m ()
stopAllConnections LocalNode{NodeState Pid Term Mailbox Connection
nodeState :: NodeState Pid Term Mailbox Connection
$sel:nodeState:LocalNode :: LocalNode -> NodeState Pid Term Mailbox Connection
nodeState} = do
        [(Term, Connection)]
cs <- IO [(Term, Connection)] -> m [(Term, Connection)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Term, Connection)] -> m [(Term, Connection)])
-> IO [(Term, Connection)] -> m [(Term, Connection)]
forall a b. (a -> b) -> a -> b
$ NodeState Pid Term Mailbox Connection -> IO [(Term, Connection)]
forall p n mb c. NodeState p n mb c -> IO [(n, c)]
getConnectedNodes NodeState Pid Term Mailbox Connection
nodeState
        ((Term, Connection) -> m ()) -> [(Term, Connection)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Term, Connection) -> IO ()) -> (Term, Connection) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
closeConnection (Connection -> IO ())
-> ((Term, Connection) -> Connection)
-> (Term, Connection)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term, Connection) -> Connection
forall a b. (a, b) -> b
snd) [(Term, Connection)]
cs

make_mailbox :: (MonadResource m) => NodeT m Mailbox
make_mailbox :: NodeT m Mailbox
make_mailbox = do
    Pid
self <- NodeT m Pid
forall (m :: * -> *). MonadIO m => NodeT m Pid
make_pid
    TQueue Term
msgQueue <- IO (TQueue Term) -> NodeT m (TQueue Term)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TQueue Term)
forall a. IO (TQueue a)
newTQueueIO
    let mailbox :: Mailbox
mailbox = MkMailbox :: Pid -> TQueue Term -> Mailbox
MkMailbox { Pid
self :: Pid
self :: Pid
self, TQueue Term
msgQueue :: TQueue Term
msgQueue :: TQueue Term
msgQueue }
    NodeState Pid Term Mailbox Connection
nodeState <- NodeT m (NodeState Pid Term Mailbox Connection)
forall (m :: * -> *).
Monad m =>
NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState
    IO () -> NodeT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NodeState Pid Term Mailbox Connection -> Pid -> Mailbox -> IO ()
forall p n mb c. Ord p => NodeState p n mb c -> p -> mb -> IO ()
putMailboxForPid NodeState Pid Term Mailbox Connection
nodeState Pid
self Mailbox
mailbox)
    Mailbox -> NodeT m Mailbox
forall (m :: * -> *) a. Monad m => a -> m a
return Mailbox
mailbox

send :: (MonadMask m, MonadBaseControl IO m, MonadResource m, MonadLoggerIO m)
     => Pid
     -> Term
     -> NodeT m ()
send :: Pid -> Term -> NodeT m ()
send Pid
toPid Term
message = ByteString -> NodeT m (Maybe Connection)
forall (m :: * -> *).
(MonadMask m, MonadBaseControl IO m, MonadResource m,
 MonadLoggerIO m) =>
ByteString -> NodeT m (Maybe Connection)
getOrCreateConnection (Term -> ByteString
atomName (Term -> Term
node (Pid -> Term
forall a. ToTerm a => a -> Term
toTerm Pid
toPid)))
    NodeT m (Maybe Connection)
-> (Maybe Connection -> NodeT m ()) -> NodeT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeT m ()
-> (Connection -> NodeT m ()) -> Maybe Connection -> NodeT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> NodeT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ControlMessage -> Connection -> NodeT m ()
forall (m :: * -> *).
MonadIO m =>
ControlMessage -> Connection -> m ()
sendControlMessage (Pid -> Term -> ControlMessage
SEND Pid
toPid Term
message))

sendReg :: (MonadMask m, MonadBaseControl IO m, MonadResource m, MonadLoggerIO m)
        => Mailbox
        -> Term
        -> Term
        -> Term
        -> NodeT m ()
sendReg :: Mailbox -> Term -> Term -> Term -> NodeT m ()
sendReg MkMailbox{Pid
self :: Pid
self :: Mailbox -> Pid
self} Term
regName Term
nodeName Term
message =
    ByteString -> NodeT m (Maybe Connection)
forall (m :: * -> *).
(MonadMask m, MonadBaseControl IO m, MonadResource m,
 MonadLoggerIO m) =>
ByteString -> NodeT m (Maybe Connection)
getOrCreateConnection (Term -> ByteString
atomName Term
nodeName) NodeT m (Maybe Connection)
-> (Maybe Connection -> NodeT m ()) -> NodeT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        NodeT m ()
-> (Connection -> NodeT m ()) -> Maybe Connection -> NodeT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> NodeT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ControlMessage -> Connection -> NodeT m ()
forall (m :: * -> *).
MonadIO m =>
ControlMessage -> Connection -> m ()
sendControlMessage (Pid -> Term -> Term -> ControlMessage
REG_SEND Pid
self Term
regName Term
message))

splitNodeName :: CS.ByteString -> (CS.ByteString, CS.ByteString)
splitNodeName :: ByteString -> (ByteString, ByteString)
splitNodeName ByteString
a = case Char -> ByteString -> [ByteString]
CS.split Char
'@' ByteString
a of
    [ ByteString
alive, ByteString
host ] -> (ByteString
alive, ByteString
host)
    [ByteString]
_ -> String -> (ByteString, ByteString)
forall a. HasCallStack => String -> a
error (String -> (ByteString, ByteString))
-> String -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ String
"Illegal node name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
a

getOrCreateConnection :: (MonadMask m, MonadBaseControl IO m, MonadResource m, MonadLoggerIO m)
                      => CS.ByteString
                      -> NodeT m (Maybe Connection)
getOrCreateConnection :: ByteString -> NodeT m (Maybe Connection)
getOrCreateConnection ByteString
remoteName =
    NodeT m (Maybe Connection)
getExistingConnection NodeT m (Maybe Connection)
-> (Maybe Connection -> NodeT m (Maybe Connection))
-> NodeT m (Maybe Connection)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeT m (Maybe Connection)
-> (Connection -> NodeT m (Maybe Connection))
-> Maybe Connection
-> NodeT m (Maybe Connection)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeT m (Maybe Connection)
lookupAndConnect (Maybe Connection -> NodeT m (Maybe Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Connection -> NodeT m (Maybe Connection))
-> (Connection -> Maybe Connection)
-> Connection
-> NodeT m (Maybe Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Maybe Connection
forall a. a -> Maybe a
Just)
  where
    getExistingConnection :: NodeT m (Maybe Connection)
getExistingConnection = do
        let nodeName :: Term
nodeName = ByteString -> Term
atom ByteString
remoteName
        String -> NodeT m ()
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
String -> m ()
logInfoStr (String -> ShowS
forall r. PrintfType r => String -> r
printf String
"getExistingConnection %s" (Term -> String
forall a. Show a => a -> String
show Term
nodeName))
        NodeState Pid Term Mailbox Connection
nodeState <- NodeT m (NodeState Pid Term Mailbox Connection)
forall (m :: * -> *).
Monad m =>
NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState
        NodeState Pid Term Mailbox Connection -> NodeT m ()
forall n (m :: * -> *) p mb c.
(Show n, MonadIO m, MonadLogger m) =>
NodeState p n mb c -> m ()
logNodeState NodeState Pid Term Mailbox Connection
nodeState
        NodeState Pid Term Mailbox Connection
-> Term -> NodeT m (Maybe Connection)
forall (m :: * -> *) n p mb c.
(MonadIO m, Ord n) =>
NodeState p n mb c -> n -> m (Maybe c)
getConnectionForNode NodeState Pid Term Mailbox Connection
nodeState Term
nodeName

    lookupAndConnect :: NodeT m (Maybe Connection)
lookupAndConnect = ByteString -> ByteString -> NodeT m (Maybe NodeData)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadLogger m) =>
ByteString -> ByteString -> m (Maybe NodeData)
lookupNode ByteString
remoteAlive ByteString
remoteHost NodeT m (Maybe NodeData)
-> (Maybe NodeData -> NodeT m (Maybe Connection))
-> NodeT m (Maybe Connection)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        NodeT m (Maybe Connection)
-> (NodeData -> NodeT m (Maybe Connection))
-> Maybe NodeData
-> NodeT m (Maybe Connection)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeT m (Maybe Connection)
warnNotFound NodeData -> NodeT m (Maybe Connection)
connect
      where
        (ByteString
remoteAlive, ByteString
remoteHost) =
            ByteString -> (ByteString, ByteString)
splitNodeName ByteString
remoteName
        warnNotFound :: NodeT m (Maybe Connection)
warnNotFound = do
            String -> NodeT m ()
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
String -> m ()
logWarnStr (String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Connection failed: Node '%s' not found on '%s'."
                               (ByteString -> String
CS.unpack ByteString
remoteAlive)
                               (ByteString -> String
CS.unpack ByteString
remoteHost))
            Maybe Connection -> NodeT m (Maybe Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Connection
forall a. Maybe a
Nothing
        connect :: NodeData -> NodeT m (Maybe Connection)
connect NodeData{portNo :: NodeData -> Word16
portNo = Word16
remotePort} =
            NodeT m BufferedSocket
-> (BufferedSocket -> NodeT m (Maybe Any))
-> (BufferedSocket -> NodeT m (Maybe Connection))
-> NodeT m (Maybe Connection)
forall (m :: * -> *) a b c.
(HasCallStack, MonadMask m, MonadLogger m) =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnErrorLog (IO BufferedSocket -> NodeT m BufferedSocket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> Word16 -> IO Socket
connectSocket ByteString
remoteHost Word16
remotePort IO Socket -> (Socket -> IO BufferedSocket) -> IO BufferedSocket
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                           Socket -> IO BufferedSocket
makeBuffered))
                              BufferedSocket -> NodeT m (Maybe Any)
forall (m :: * -> *) a a.
(MonadIO m, BufferedIOx a) =>
a -> m (Maybe a)
cleanup
                              BufferedSocket -> NodeT m (Maybe Connection)
go
          where
            cleanup :: a -> m (Maybe a)
cleanup a
sock = do
                IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO ()
forall a (m :: * -> *). (BufferedIOx a, MonadIO m) => a -> m ()
closeBuffered a
sock)
                Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
            go :: BufferedSocket -> NodeT m (Maybe Connection)
go BufferedSocket
sock = Connection -> Maybe Connection
forall a. a -> Maybe a
Just (Connection -> Maybe Connection)
-> NodeT m Connection -> NodeT m (Maybe Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                               NodeState Pid Term Mailbox Connection
nodeState <- NodeT m (NodeState Pid Term Mailbox Connection)
forall (m :: * -> *).
Monad m =>
NodeT m (NodeState Pid Term Mailbox Connection)
askNodeState
                               LocalNode{HandshakeData
handshakeData :: HandshakeData
$sel:handshakeData:LocalNode :: LocalNode -> HandshakeData
handshakeData} <- NodeT m LocalNode
forall (m :: * -> *). Monad m => NodeT m LocalNode
askLocalNode
                               (forall o. Binary o => o -> NodeT m ())
-> (forall i. Binary i => NodeT m i) -> HandshakeData -> NodeT m ()
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
(forall o. Binary o => o -> m ())
-> (forall i. Binary i => m i) -> HandshakeData -> m ()
doConnect (BufferedSocket -> o -> NodeT m ()
forall (m :: * -> *) s a.
(MonadIO m, BufferedIOx s, Binary a) =>
s -> a -> m ()
runPutBuffered BufferedSocket
sock)
                                         (BufferedSocket -> NodeT m i
forall (m :: * -> *) s a.
(MonadIO m, BufferedIOx s, Binary a, MonadMask m, MonadLogger m) =>
s -> m a
runGetBuffered BufferedSocket
sock)
                                         HandshakeData
handshakeData
                               BufferedSocket
-> NodeState Pid Term Mailbox Connection
-> Term
-> NodeT m Connection
forall (m :: * -> *) s.
(MonadLoggerIO m, MonadMask m, MonadBaseControl IO m,
 BufferedIOx s) =>
s -> NodeState Pid Term Mailbox Connection -> Term -> m Connection
newConnection BufferedSocket
sock NodeState Pid Term Mailbox Connection
nodeState (ByteString -> Term
atom ByteString
remoteName)