{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TupleSections         #-}
module Haskoin.Node.Manager
    ( PeerManagerConfig (..)
    , PeerEvent (..)
    , OnlinePeer (..)
    , HostPort
    , Host
    , Port
    , PeerManager
    , withPeerManager
    , managerBest
    , managerVersion
    , managerPing
    , managerPong
    , managerAddrs
    , managerVerAck
    , managerTickle
    , getPeers
    , getOnlinePeer
    , buildVersion
    , myVersion
    ) where

import           Control.Monad             (forM_, forever, guard, void, when,
                                            (<=<))
import           Control.Monad.Except      (ExceptT (..), runExceptT,
                                            throwError)
import           Control.Monad.Logger      (MonadLogger, MonadLoggerIO,
                                            logDebugS, logErrorS, logInfoS,
                                            logWarnS)
import           Control.Monad.Reader      (MonadReader, ReaderT (ReaderT), ask,
                                            asks, runReaderT)
import           Control.Monad.Trans       (lift)
import           Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import           Data.Bits                 ((.&.))
import           Data.Function             (on)
import           Data.List                 (find, nub, sort)
import           Data.Maybe                (fromMaybe, isJust)
import           Data.Set                  (Set)
import qualified Data.Set                  as Set
import           Data.String.Conversions   (cs)
import           Data.Time.Clock           (NominalDiffTime, UTCTime,
                                            addUTCTime, diffUTCTime,
                                            getCurrentTime)
import           Data.Time.Clock.POSIX     (utcTimeToPOSIXSeconds)
import           Data.Word                 (Word32, Word64)
import           Haskoin                   (BlockHeight, Message (..),
                                            Network (..), NetworkAddress (..),
                                            Ping (..), Pong (..),
                                            VarString (..), Version (..),
                                            hostToSockAddr, nodeNetwork,
                                            sockToHostAddress)
import           Haskoin.Node.Peer
import           NQE                       (Child, Inbox, Mailbox, Publisher,
                                            Strategy (..), Supervisor, addChild,
                                            inboxToMailbox, newInbox,
                                            newMailbox, publish, receive,
                                            receiveMatch, send, sendSTM,
                                            withSupervisor)
import           Network.Socket            (AddrInfo (..), AddrInfoFlag (..),
                                            Family (..), SockAddr (..),
                                            SocketType (..), defaultHints,
                                            getAddrInfo)
import           System.Random             (randomIO, randomRIO)
import           UnliftIO                  (Async, MonadIO, MonadUnliftIO, STM,
                                            SomeException, TVar, atomically,
                                            catch, liftIO, link, modifyTVar,
                                            newTVarIO, readTVar, readTVarIO,
                                            withAsync, withRunInIO, writeTVar)
import           UnliftIO.Concurrent       (threadDelay)

type HostPort = (Host, Port)
type Host = String
type Port = Int

type MonadManager m = (MonadIO m, MonadReader PeerManager m)

data PeerEvent
    = PeerConnected !Peer
    | PeerDisconnected !Peer
    deriving PeerEvent -> PeerEvent -> Bool
(PeerEvent -> PeerEvent -> Bool)
-> (PeerEvent -> PeerEvent -> Bool) -> Eq PeerEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PeerEvent -> PeerEvent -> Bool
$c/= :: PeerEvent -> PeerEvent -> Bool
== :: PeerEvent -> PeerEvent -> Bool
$c== :: PeerEvent -> PeerEvent -> Bool
Eq

data PeerManagerConfig =
    PeerManagerConfig
        { PeerManagerConfig -> Int
peerManagerMaxPeers :: !Int
        , PeerManagerConfig -> [HostPort]
peerManagerPeers    :: ![HostPort]
        , PeerManagerConfig -> Bool
peerManagerDiscover :: !Bool
        , PeerManagerConfig -> NetworkAddress
peerManagerNetAddr  :: !NetworkAddress
        , PeerManagerConfig -> Network
peerManagerNetwork  :: !Network
        , PeerManagerConfig -> Publisher PeerEvent
peerManagerEvents   :: !(Publisher PeerEvent)
        , PeerManagerConfig -> NominalDiffTime
peerManagerTimeout  :: !NominalDiffTime
        , PeerManagerConfig -> NominalDiffTime
peerManagerMaxLife  :: !NominalDiffTime
        , PeerManagerConfig -> SockAddr -> WithConnection
peerManagerConnect  :: !(SockAddr -> WithConnection)
        , PeerManagerConfig -> Publisher (Peer, Message)
peerManagerPub      :: !(Publisher (Peer, Message))
        }

data PeerManager =
    PeerManager
        { PeerManager -> PeerManagerConfig
myConfig     :: !PeerManagerConfig
        , PeerManager -> Supervisor
mySupervisor :: !Supervisor
        , PeerManager -> Mailbox ManagerMessage
myMailbox    :: !(Mailbox ManagerMessage)
        , PeerManager -> TVar BlockHeight
myBestBlock  :: !(TVar BlockHeight)
        , PeerManager -> TVar (Set SockAddr)
knownPeers   :: !(TVar (Set SockAddr))
        , PeerManager -> TVar [OnlinePeer]
onlinePeers  :: !(TVar [OnlinePeer])
        }

data ManagerMessage
    = Connect !SockAddr
    | CheckPeer !Peer
    | PeerDied !Child !(Maybe SomeException)
    | ManagerBest !BlockHeight
    | PeerVerAck !Peer
    | PeerVersion !Peer !Version
    | PeerPing !Peer !Word64
    | PeerPong !Peer !Word64
    | PeerAddrs !Peer ![NetworkAddress]
    | PeerTickle !Peer

-- | Data structure representing an online peer.
data OnlinePeer =
    OnlinePeer
        { OnlinePeer -> SockAddr
onlinePeerAddress     :: !SockAddr
        , OnlinePeer -> Bool
onlinePeerVerAck      :: !Bool
        , OnlinePeer -> Bool
onlinePeerConnected   :: !Bool
        , OnlinePeer -> Maybe Version
onlinePeerVersion     :: !(Maybe Version)
        , OnlinePeer -> Async ()
onlinePeerAsync       :: !(Async ())
        , OnlinePeer -> Peer
onlinePeerMailbox     :: !Peer
        , OnlinePeer -> Word64
onlinePeerNonce       :: !Word64
        , OnlinePeer -> Maybe (UTCTime, Word64)
onlinePeerPing        :: !(Maybe (UTCTime, Word64))
        , OnlinePeer -> [NominalDiffTime]
onlinePeerPings       :: ![NominalDiffTime]
        , OnlinePeer -> UTCTime
onlinePeerConnectTime :: !UTCTime
        , OnlinePeer -> UTCTime
onlinePeerTickled     :: !UTCTime
        , OnlinePeer -> UTCTime
onlinePeerDisconnect  :: !UTCTime
        }

instance Eq OnlinePeer where
    == :: OnlinePeer -> OnlinePeer -> Bool
(==) = Peer -> Peer -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Peer -> Peer -> Bool)
-> (OnlinePeer -> Peer) -> OnlinePeer -> OnlinePeer -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OnlinePeer -> Peer
f
      where
        f :: OnlinePeer -> Peer
f OnlinePeer {onlinePeerMailbox :: OnlinePeer -> Peer
onlinePeerMailbox = Peer
p} = Peer
p

instance Ord OnlinePeer where
    compare :: OnlinePeer -> OnlinePeer -> Ordering
compare = NominalDiffTime -> NominalDiffTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NominalDiffTime -> NominalDiffTime -> Ordering)
-> (OnlinePeer -> NominalDiffTime)
-> OnlinePeer
-> OnlinePeer
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OnlinePeer -> NominalDiffTime
f
      where
        f :: OnlinePeer -> NominalDiffTime
f OnlinePeer {onlinePeerPings :: OnlinePeer -> [NominalDiffTime]
onlinePeerPings = [NominalDiffTime]
pings} = NominalDiffTime -> Maybe NominalDiffTime -> NominalDiffTime
forall a. a -> Maybe a -> a
fromMaybe 60 ([NominalDiffTime] -> Maybe NominalDiffTime
forall a. (Ord a, Fractional a) => [a] -> Maybe a
median [NominalDiffTime]
pings)

withPeerManager :: (MonadUnliftIO m, MonadLoggerIO m)
                => PeerManagerConfig
                -> (PeerManager -> m a)
                -> m a
withPeerManager :: PeerManagerConfig -> (PeerManager -> m a) -> m a
withPeerManager cfg :: PeerManagerConfig
cfg action :: PeerManager -> m a
action = do
    Inbox ManagerMessage
inbox <- m (Inbox ManagerMessage)
forall (m :: * -> *) msg. MonadIO m => m (Inbox msg)
newInbox
    let mgr :: Mailbox ManagerMessage
mgr = Inbox ManagerMessage -> Mailbox ManagerMessage
forall msg. Inbox msg -> Mailbox msg
inboxToMailbox Inbox ManagerMessage
inbox
    Strategy -> (Supervisor -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Strategy -> (Supervisor -> m a) -> m a
withSupervisor (Listen (Async (), Maybe SomeException) -> Strategy
Notify (Mailbox ManagerMessage -> Listen (Async (), Maybe SomeException)
forall (mbox :: * -> *).
OutChan mbox =>
mbox ManagerMessage -> Listen (Async (), Maybe SomeException)
death Mailbox ManagerMessage
mgr)) ((Supervisor -> m a) -> m a) -> (Supervisor -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \sup :: Supervisor
sup -> do
        TVar BlockHeight
bb <- BlockHeight -> m (TVar BlockHeight)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO 0
        TVar (Set SockAddr)
kp <- Set SockAddr -> m (TVar (Set SockAddr))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Set SockAddr
forall a. Set a
Set.empty
        TVar [OnlinePeer]
ob <- [OnlinePeer] -> m (TVar [OnlinePeer])
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO []
        let rd :: PeerManager
rd = $WPeerManager :: PeerManagerConfig
-> Supervisor
-> Mailbox ManagerMessage
-> TVar BlockHeight
-> TVar (Set SockAddr)
-> TVar [OnlinePeer]
-> PeerManager
PeerManager { myConfig :: PeerManagerConfig
myConfig = PeerManagerConfig
cfg
                             , mySupervisor :: Supervisor
mySupervisor = Supervisor
sup
                             , myMailbox :: Mailbox ManagerMessage
myMailbox = Mailbox ManagerMessage
mgr
                             , myBestBlock :: TVar BlockHeight
myBestBlock = TVar BlockHeight
bb
                             , knownPeers :: TVar (Set SockAddr)
knownPeers = TVar (Set SockAddr)
kp
                             , onlinePeers :: TVar [OnlinePeer]
onlinePeers = TVar [OnlinePeer]
ob
                             }
        Inbox ManagerMessage -> ReaderT PeerManager m a
go Inbox ManagerMessage
inbox ReaderT PeerManager m a -> PeerManager -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` PeerManager
rd
  where
    death :: mbox ManagerMessage -> Listen (Async (), Maybe SomeException)
death mgr :: mbox ManagerMessage
mgr (a :: Async ()
a, ex :: Maybe SomeException
ex) = Async () -> Maybe SomeException -> ManagerMessage
PeerDied Async ()
a Maybe SomeException
ex ManagerMessage -> mbox ManagerMessage -> STM ()
forall (mbox :: * -> *) msg.
OutChan mbox =>
msg -> mbox msg -> STM ()
`sendSTM` mbox ManagerMessage
mgr
    go :: Inbox ManagerMessage -> ReaderT PeerManager m a
go inbox :: Inbox ManagerMessage
inbox =
        ReaderT PeerManager m ()
-> (Async () -> ReaderT PeerManager m a) -> ReaderT PeerManager m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (Inbox ManagerMessage -> ReaderT PeerManager m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadManager m, MonadLoggerIO m) =>
Inbox ManagerMessage -> m ()
peerManager Inbox ManagerMessage
inbox) ((Async () -> ReaderT PeerManager m a) -> ReaderT PeerManager m a)
-> (Async () -> ReaderT PeerManager m a) -> ReaderT PeerManager m a
forall a b. (a -> b) -> a -> b
$ \a :: Async ()
a ->
        ReaderT PeerManager m a -> ReaderT PeerManager m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadManager m) =>
m a -> m a
withConnectLoop (ReaderT PeerManager m a -> ReaderT PeerManager m a)
-> ReaderT PeerManager m a -> ReaderT PeerManager m a
forall a b. (a -> b) -> a -> b
$
        Async () -> ReaderT PeerManager m ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
link Async ()
a ReaderT PeerManager m ()
-> ReaderT PeerManager m a -> ReaderT PeerManager m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PeerManager -> m a) -> ReaderT PeerManager m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT PeerManager -> m a
action

peerManager :: ( MonadUnliftIO m
               , MonadManager m
               , MonadLoggerIO m )
            => Inbox ManagerMessage
            -> m ()
peerManager :: Inbox ManagerMessage -> m ()
peerManager inb :: Inbox ManagerMessage
inb = do
    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
logDebugS) "PeerManager" "Awaiting best block"
    BlockHeight -> m ()
forall (m :: * -> *). MonadManager m => BlockHeight -> m ()
putBestBlock (BlockHeight -> m ())
-> ((ManagerMessage -> Maybe BlockHeight) -> m BlockHeight)
-> (ManagerMessage -> Maybe BlockHeight)
-> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Inbox ManagerMessage
-> (ManagerMessage -> Maybe BlockHeight) -> m BlockHeight
forall (m :: * -> *) (mbox :: * -> *) msg a.
(MonadIO m, InChan mbox) =>
mbox msg -> (msg -> Maybe a) -> m a
receiveMatch Inbox ManagerMessage
inb ((ManagerMessage -> Maybe BlockHeight) -> m ())
-> (ManagerMessage -> Maybe BlockHeight) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
        ManagerBest b :: BlockHeight
b -> BlockHeight -> Maybe BlockHeight
forall a. a -> Maybe a
Just BlockHeight
b
        _             -> Maybe BlockHeight
forall a. Maybe a
Nothing
    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "PeerManager" "Starting peer manager actor"
    m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever m ()
loop
  where
    loop :: m ()
loop = do
        ManagerMessage
m <- Inbox ManagerMessage -> m ManagerMessage
forall (mbox :: * -> *) (m :: * -> *) msg.
(InChan mbox, MonadIO m) =>
mbox msg -> m msg
receive Inbox ManagerMessage
inb
        ManagerMessage -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadManager m, MonadLoggerIO m) =>
ManagerMessage -> m ()
managerMessage ManagerMessage
m

putBestBlock :: MonadManager m => BlockHeight -> m ()
putBestBlock :: BlockHeight -> m ()
putBestBlock bb :: BlockHeight
bb = do
    TVar BlockHeight
b <- (PeerManager -> TVar BlockHeight) -> m (TVar BlockHeight)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar BlockHeight
myBestBlock
    STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar BlockHeight -> BlockHeight -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar BlockHeight
b BlockHeight
bb

getBestBlock :: MonadManager m => m BlockHeight
getBestBlock :: m BlockHeight
getBestBlock =
    (PeerManager -> TVar BlockHeight) -> m (TVar BlockHeight)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar BlockHeight
myBestBlock m (TVar BlockHeight)
-> (TVar BlockHeight -> m BlockHeight) -> m BlockHeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar BlockHeight -> m BlockHeight
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO

getNetwork :: MonadManager m => m Network
getNetwork :: m Network
getNetwork =
    (PeerManager -> Network) -> m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> Network
peerManagerNetwork (PeerManagerConfig -> Network)
-> (PeerManager -> PeerManagerConfig) -> PeerManager -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)

loadPeers :: (MonadUnliftIO m, MonadManager m) => m ()
loadPeers :: m ()
loadPeers = do
    m ()
forall (m :: * -> *). (MonadUnliftIO m, MonadManager m) => m ()
loadStaticPeers
    m ()
forall (m :: * -> *). (MonadUnliftIO m, MonadManager m) => m ()
loadNetSeeds

loadStaticPeers :: (MonadUnliftIO m, MonadManager m) => m ()
loadStaticPeers :: m ()
loadStaticPeers = do
    [HostPort]
xs <- (PeerManager -> [HostPort]) -> m [HostPort]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> [HostPort]
peerManagerPeers (PeerManagerConfig -> [HostPort])
-> (PeerManager -> PeerManagerConfig) -> PeerManager -> [HostPort]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)
    (SockAddr -> m ()) -> [SockAddr] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SockAddr -> m ()
forall (m :: * -> *).
(MonadIO m, MonadManager m) =>
SockAddr -> m ()
newPeer ([SockAddr] -> m ()) -> m [SockAddr] -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[SockAddr]] -> [SockAddr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SockAddr]] -> [SockAddr]) -> m [[SockAddr]] -> m [SockAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HostPort -> m [SockAddr]) -> [HostPort] -> m [[SockAddr]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HostPort -> m [SockAddr]
forall (m :: * -> *). MonadUnliftIO m => HostPort -> m [SockAddr]
toSockAddr [HostPort]
xs

loadNetSeeds :: (MonadUnliftIO m, MonadManager m) => m ()
loadNetSeeds :: m ()
loadNetSeeds =
    (PeerManager -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> Bool
peerManagerDiscover (PeerManagerConfig -> Bool)
-> (PeerManager -> PeerManagerConfig) -> PeerManager -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig) m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \discover :: Bool
discover ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
discover (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            Network
net <- m Network
forall (m :: * -> *). MonadManager m => m Network
getNetwork
            [SockAddr]
ss <- [[SockAddr]] -> [SockAddr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SockAddr]] -> [SockAddr]) -> m [[SockAddr]] -> m [SockAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HostPort -> m [SockAddr]) -> [HostPort] -> m [[SockAddr]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HostPort -> m [SockAddr]
forall (m :: * -> *). MonadUnliftIO m => HostPort -> m [SockAddr]
toSockAddr (Network -> [HostPort]
networkSeeds Network
net)
            (SockAddr -> m ()) -> [SockAddr] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SockAddr -> m ()
forall (m :: * -> *).
(MonadIO m, MonadManager m) =>
SockAddr -> m ()
newPeer [SockAddr]
ss

logConnectedPeers :: (MonadManager m, MonadLoggerIO m) => m ()
logConnectedPeers :: m ()
logConnectedPeers = do
    Int
m <- (PeerManager -> Int) -> m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> Int
peerManagerMaxPeers (PeerManagerConfig -> Int)
-> (PeerManager -> PeerManagerConfig) -> PeerManager -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)
    Int
l <- [OnlinePeer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([OnlinePeer] -> Int) -> m [OnlinePeer] -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [OnlinePeer]
forall (m :: * -> *). MonadManager m => m [OnlinePeer]
getConnectedPeers
    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logInfoS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Peers connected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
m)

getOnlinePeers :: MonadManager m => m [OnlinePeer]
getOnlinePeers :: m [OnlinePeer]
getOnlinePeers =
    (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers m (TVar [OnlinePeer])
-> (TVar [OnlinePeer] -> m [OnlinePeer]) -> m [OnlinePeer]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar [OnlinePeer] -> m [OnlinePeer]
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO

getConnectedPeers :: MonadManager m => m [OnlinePeer]
getConnectedPeers :: m [OnlinePeer]
getConnectedPeers =
    (OnlinePeer -> Bool) -> [OnlinePeer] -> [OnlinePeer]
forall a. (a -> Bool) -> [a] -> [a]
filter OnlinePeer -> Bool
onlinePeerConnected ([OnlinePeer] -> [OnlinePeer]) -> m [OnlinePeer] -> m [OnlinePeer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [OnlinePeer]
forall (m :: * -> *). MonadManager m => m [OnlinePeer]
getOnlinePeers

managerEvent :: MonadManager m => PeerEvent -> m ()
managerEvent :: PeerEvent -> m ()
managerEvent e :: PeerEvent
e =
    PeerEvent -> Publisher PeerEvent -> m ()
forall (m :: * -> *) msg. MonadIO m => msg -> Publisher msg -> m ()
publish PeerEvent
e (Publisher PeerEvent -> m ()) -> m (Publisher PeerEvent) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PeerManager -> Publisher PeerEvent) -> m (Publisher PeerEvent)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> Publisher PeerEvent
peerManagerEvents (PeerManagerConfig -> Publisher PeerEvent)
-> (PeerManager -> PeerManagerConfig)
-> PeerManager
-> Publisher PeerEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)

managerMessage :: ( MonadUnliftIO m
                  , MonadManager m
                  , MonadLoggerIO m )
               => ManagerMessage
               -> m ()

managerMessage :: ManagerMessage -> m ()
managerMessage (PeerVersion p :: Peer
p v :: Version
v) = do
    TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    Either PeerException ()
e <- ExceptT PeerException m () -> m (Either PeerException ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PeerException m () -> m (Either PeerException ()))
-> ExceptT PeerException m () -> m (Either PeerException ())
forall a b. (a -> b) -> a -> b
$ do
        OnlinePeer
o <- m (Either PeerException OnlinePeer)
-> ExceptT PeerException m OnlinePeer
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either PeerException OnlinePeer)
 -> ExceptT PeerException m OnlinePeer)
-> (STM (Either PeerException OnlinePeer)
    -> m (Either PeerException OnlinePeer))
-> STM (Either PeerException OnlinePeer)
-> ExceptT PeerException m OnlinePeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM (Either PeerException OnlinePeer)
-> m (Either PeerException OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Either PeerException OnlinePeer)
 -> ExceptT PeerException m OnlinePeer)
-> STM (Either PeerException OnlinePeer)
-> ExceptT PeerException m OnlinePeer
forall a b. (a -> b) -> a -> b
$ TVar [OnlinePeer]
-> Peer -> Version -> STM (Either PeerException OnlinePeer)
setPeerVersion TVar [OnlinePeer]
b Peer
p Version
v
        Bool -> ExceptT PeerException m () -> ExceptT PeerException m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OnlinePeer -> Bool
onlinePeerConnected OnlinePeer
o) (ExceptT PeerException m () -> ExceptT PeerException m ())
-> ExceptT PeerException m () -> ExceptT PeerException m ()
forall a b. (a -> b) -> a -> b
$ Peer -> ExceptT PeerException m ()
forall (m :: * -> *).
(MonadManager m, MonadLoggerIO m) =>
Peer -> m ()
announcePeer Peer
p
    case Either PeerException ()
e of
        Right () -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                "Sending version ack to peer: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
            Message
MVerAck Message -> Peer -> m ()
forall (m :: * -> *). MonadIO m => Message -> Peer -> m ()
`sendMessage` Peer
p
        Left x :: PeerException
x -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                "Version rejected for peer "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (PeerException -> String
forall a. Show a => a -> String
show PeerException
x)
            PeerException -> Peer -> m ()
forall (m :: * -> *). MonadIO m => PeerException -> Peer -> m ()
killPeer PeerException
x Peer
p

managerMessage (PeerVerAck p :: Peer
p) = do
    TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    STM (Maybe OnlinePeer) -> m (Maybe OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
setPeerVerAck TVar [OnlinePeer]
b Peer
p) m (Maybe OnlinePeer) -> (Maybe OnlinePeer -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just o :: OnlinePeer
o -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                "Received version ack from peer: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OnlinePeer -> Bool
onlinePeerConnected OnlinePeer
o) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Peer -> m ()
forall (m :: * -> *).
(MonadManager m, MonadLoggerIO m) =>
Peer -> m ()
announcePeer Peer
p
        Nothing -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                "Received verack from unknown peer: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
            PeerException -> Peer -> m ()
forall (m :: * -> *). MonadIO m => PeerException -> Peer -> m ()
killPeer PeerException
UnknownPeer Peer
p

managerMessage (PeerAddrs p :: Peer
p nas :: [NetworkAddress]
nas) = do
    Bool
discover <- (PeerManager -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> Bool
peerManagerDiscover (PeerManagerConfig -> Bool)
-> (PeerManager -> PeerManagerConfig) -> PeerManager -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
discover (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        let sas :: [SockAddr]
sas = (NetworkAddress -> SockAddr) -> [NetworkAddress] -> [SockAddr]
forall a b. (a -> b) -> [a] -> [b]
map (HostAddress -> SockAddr
hostToSockAddr (HostAddress -> SockAddr)
-> (NetworkAddress -> HostAddress) -> NetworkAddress -> SockAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkAddress -> HostAddress
naAddress) [NetworkAddress]
nas
        [(Int, SockAddr)] -> ((Int, SockAddr) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [SockAddr] -> [(Int, SockAddr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(1 :: Int) ..] [SockAddr]
sas) (((Int, SockAddr) -> m ()) -> m ())
-> ((Int, SockAddr) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(i :: Int
i, a :: SockAddr
a) -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                "Got peer address "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([SockAddr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SockAddr]
sas))
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (SockAddr -> String
forall a. Show a => a -> String
show SockAddr
a)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " from peer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
            SockAddr -> m ()
forall (m :: * -> *).
(MonadIO m, MonadManager m) =>
SockAddr -> m ()
newPeer SockAddr
a

managerMessage (PeerPong p :: Peer
p n :: Word64
n) = do
    TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Received pong "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Word64 -> String
forall a. Show a => a -> String
show Word64
n)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " from: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
    UTCTime
now <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar [OnlinePeer] -> Word64 -> UTCTime -> Peer -> STM ()
gotPong TVar [OnlinePeer]
b Word64
n UTCTime
now Peer
p)

managerMessage (PeerPing p :: Peer
p n :: Word64
n) = do
    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Responding to ping "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Word64 -> String
forall a. Show a => a -> String
show Word64
n)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " from: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
    Pong -> Message
MPong (Word64 -> Pong
Pong Word64
n) Message -> Peer -> m ()
forall (m :: * -> *). MonadIO m => Message -> Peer -> m ()
`sendMessage` Peer
p

managerMessage (ManagerBest h :: BlockHeight
h) =
    BlockHeight -> m ()
forall (m :: * -> *). MonadManager m => BlockHeight -> m ()
putBestBlock BlockHeight
h

managerMessage (Connect sa :: SockAddr
sa) =
    SockAddr -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadManager m, MonadLoggerIO m) =>
SockAddr -> m ()
connectPeer SockAddr
sa

managerMessage (PeerDied a :: Async ()
a e :: Maybe SomeException
e) =
    Async () -> Maybe SomeException -> m ()
forall (m :: * -> *).
(MonadManager m, MonadLoggerIO m) =>
Async () -> Maybe SomeException -> m ()
processPeerOffline Async ()
a Maybe SomeException
e

managerMessage (CheckPeer p :: Peer
p) =
    Peer -> m ()
forall (m :: * -> *).
(MonadManager m, MonadLoggerIO m) =>
Peer -> m ()
checkPeer Peer
p

managerMessage (PeerTickle p :: Peer
p) = do
    TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    UTCTime
now <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$
        TVar [OnlinePeer] -> Peer -> (OnlinePeer -> OnlinePeer) -> STM ()
modifyPeer TVar [OnlinePeer]
b Peer
p ((OnlinePeer -> OnlinePeer) -> STM ())
-> (OnlinePeer -> OnlinePeer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \o :: OnlinePeer
o ->
        OnlinePeer
o { onlinePeerTickled :: UTCTime
onlinePeerTickled = UTCTime
now }

checkPeer :: (MonadManager m, MonadLoggerIO m) => Peer -> m ()
checkPeer :: Peer -> m ()
checkPeer p :: Peer
p =
    Peer -> m Bool
forall (m :: * -> *). MonadIO m => Peer -> m Bool
getBusy Peer
p m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        False -> do
            NominalDiffTime
to <- (PeerManager -> NominalDiffTime) -> m NominalDiffTime
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> NominalDiffTime
peerManagerTimeout (PeerManagerConfig -> NominalDiffTime)
-> (PeerManager -> PeerManagerConfig)
-> PeerManager
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)
            TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
            STM (Maybe OnlinePeer) -> m (Maybe OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer TVar [OnlinePeer]
b Peer
p) m (Maybe OnlinePeer) -> (Maybe OnlinePeer -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just o :: OnlinePeer
o -> do
                    UTCTime
now <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
                    UTCTime -> OnlinePeer -> m ()
forall (f :: * -> *). MonadIO f => UTCTime -> OnlinePeer -> f ()
check_conn UTCTime
now OnlinePeer
o
                    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime -> NominalDiffTime -> OnlinePeer -> Bool
check_tickle UTCTime
now NominalDiffTime
to OnlinePeer
o) (OnlinePeer -> m ()
forall (m :: * -> *).
(MonadReader PeerManager m, MonadLoggerIO m) =>
OnlinePeer -> m ()
check_ping OnlinePeer
o)
  where
    check_tickle :: UTCTime -> NominalDiffTime -> OnlinePeer -> Bool
check_tickle now :: UTCTime
now to :: NominalDiffTime
to o :: OnlinePeer
o =
        UTCTime
now UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` OnlinePeer -> UTCTime
onlinePeerTickled OnlinePeer
o NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
to
    check_conn :: UTCTime -> OnlinePeer -> f ()
check_conn now :: UTCTime
now o :: OnlinePeer
o =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime
now UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` OnlinePeer -> UTCTime
onlinePeerDisconnect OnlinePeer
o NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
        PeerException -> Peer -> f ()
forall (m :: * -> *). MonadIO m => PeerException -> Peer -> m ()
killPeer PeerException
PeerTooOld Peer
p
    check_ping :: OnlinePeer -> m ()
check_ping o :: OnlinePeer
o =
        case OnlinePeer -> Maybe (UTCTime, Word64)
onlinePeerPing OnlinePeer
o of
            Nothing ->
                Peer -> m ()
forall (m :: * -> *).
(MonadManager m, MonadLoggerIO m) =>
Peer -> m ()
sendPing Peer
p
            Just _ -> do
                $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logWarnS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                    "Peer ping timeout: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
                PeerException -> Peer -> m ()
forall (m :: * -> *). MonadIO m => PeerException -> Peer -> m ()
killPeer PeerException
PeerTimeout Peer
p

sendPing :: (MonadManager m, MonadLoggerIO m) => Peer -> m ()
sendPing :: Peer -> m ()
sendPing p :: Peer
p = do
    TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    STM (Maybe OnlinePeer) -> m (Maybe OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer TVar [OnlinePeer]
b Peer
p) m (Maybe OnlinePeer) -> (Maybe OnlinePeer -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing ->
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logWarnS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            "Will not ping unknown peer: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
        Just o :: OnlinePeer
o
            | OnlinePeer -> Bool
onlinePeerConnected OnlinePeer
o -> do
                Word64
n <- IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
                UTCTime
now <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
                STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar [OnlinePeer] -> Word64 -> UTCTime -> Peer -> STM ()
setPeerPing TVar [OnlinePeer]
b Word64
n UTCTime
now Peer
p)
                $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS)" PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                    "Sending ping " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Word64 -> String
forall a. Show a => a -> String
show Word64
n)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " to: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
                Ping -> Message
MPing (Word64 -> Ping
Ping Word64
n) Message -> Peer -> m ()
forall (m :: * -> *). MonadIO m => Message -> Peer -> m ()
`sendMessage` Peer
p
            | Bool
otherwise -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

processPeerOffline :: (MonadManager m, MonadLoggerIO m)
                   => Child -> Maybe SomeException -> m ()
processPeerOffline :: Async () -> Maybe SomeException -> m ()
processPeerOffline a :: Async ()
a e :: Maybe SomeException
e = do
    TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    STM (Maybe OnlinePeer) -> m (Maybe OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar [OnlinePeer] -> Async () -> STM (Maybe OnlinePeer)
findPeerAsync TVar [OnlinePeer]
b Async ()
a) m (Maybe OnlinePeer) -> (Maybe OnlinePeer -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing -> Maybe SomeException -> m ()
forall (m :: * -> *) a. (MonadLogger m, Show a) => Maybe a -> m ()
log_unknown Maybe SomeException
e
        Just o :: OnlinePeer
o -> do
            let p :: Peer
p = OnlinePeer -> Peer
onlinePeerMailbox OnlinePeer
o
            if OnlinePeer -> Bool
onlinePeerConnected OnlinePeer
o
                then do
                    Peer -> Maybe SomeException -> m ()
forall (m :: * -> *) a.
(MonadLogger m, Show a) =>
Peer -> Maybe a -> m ()
log_disconnected Peer
p Maybe SomeException
e
                    PeerEvent -> m ()
forall (m :: * -> *). MonadManager m => PeerEvent -> m ()
managerEvent (PeerEvent -> m ()) -> PeerEvent -> m ()
forall a b. (a -> b) -> a -> b
$ Peer -> PeerEvent
PeerDisconnected Peer
p
                else Peer -> Maybe SomeException -> m ()
forall (m :: * -> *) a.
(MonadLogger m, Show a) =>
Peer -> Maybe a -> m ()
log_not_connect Peer
p Maybe SomeException
e
            STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar [OnlinePeer] -> Peer -> STM ()
removePeer TVar [OnlinePeer]
b Peer
p
            m ()
forall (m :: * -> *). (MonadManager m, MonadLoggerIO m) => m ()
logConnectedPeers
  where
    log_unknown :: Maybe a -> m ()
log_unknown Nothing =
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "PeerManager"
        "Disconnected unknown peer"
    log_unknown (Just x :: a
x) =
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Unknown peer died: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (a -> String
forall a. Show a => a -> String
show a
x)
    log_disconnected :: Peer -> Maybe a -> m ()
log_disconnected p :: Peer
p Nothing =
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logWarnS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Disconnected peer: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
    log_disconnected p :: Peer
p (Just x :: a
x) =
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Peer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " died: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (a -> String
forall a. Show a => a -> String
show a
x)
    log_not_connect :: Peer -> Maybe a -> m ()
log_not_connect p :: Peer
p Nothing =
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logWarnS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Could not connect to peer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
    log_not_connect p :: Peer
p (Just x :: a
x) =
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Could not connect to peer "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (a -> String
forall a. Show a => a -> String
show a
x)

announcePeer :: (MonadManager m, MonadLoggerIO m) => Peer -> m ()
announcePeer :: Peer -> m ()
announcePeer p :: Peer
p = do
    TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    STM (Maybe OnlinePeer) -> m (Maybe OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer TVar [OnlinePeer]
b Peer
p) m (Maybe OnlinePeer) -> (Maybe OnlinePeer -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just OnlinePeer {onlinePeerConnected :: OnlinePeer -> Bool
onlinePeerConnected = Bool
True} -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logInfoS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                "Connected to peer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p
            PeerEvent -> m ()
forall (m :: * -> *). MonadManager m => PeerEvent -> m ()
managerEvent (PeerEvent -> m ()) -> PeerEvent -> m ()
forall a b. (a -> b) -> a -> b
$ Peer -> PeerEvent
PeerConnected Peer
p
            m ()
forall (m :: * -> *). (MonadManager m, MonadLoggerIO m) => m ()
logConnectedPeers
        Just OnlinePeer {onlinePeerConnected :: OnlinePeer -> Bool
onlinePeerConnected = Bool
False} ->
            () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Nothing ->
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            "Not announcing disconnected peer: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Peer -> Text
peerText Peer
p

getNewPeer :: (MonadUnliftIO m, MonadManager m) => m (Maybe SockAddr)
getNewPeer :: m (Maybe SockAddr)
getNewPeer =
    MaybeT m SockAddr -> m (Maybe SockAddr)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m SockAddr -> m (Maybe SockAddr))
-> MaybeT m SockAddr -> m (Maybe SockAddr)
forall a b. (a -> b) -> a -> b
$ m () -> MaybeT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). (MonadUnliftIO m, MonadManager m) => m ()
loadPeers MaybeT m () -> MaybeT m SockAddr -> MaybeT m SockAddr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MaybeT m SockAddr
go
  where
    go :: MaybeT m SockAddr
go = do
        TVar (Set SockAddr)
b <- (PeerManager -> TVar (Set SockAddr))
-> MaybeT m (TVar (Set SockAddr))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar (Set SockAddr)
knownPeers
        Set SockAddr
ks <- TVar (Set SockAddr) -> MaybeT m (Set SockAddr)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Set SockAddr)
b
        Bool -> MaybeT m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT m ()) -> (Bool -> Bool) -> Bool -> MaybeT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> MaybeT m ()) -> Bool -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Set SockAddr -> Bool
forall a. Set a -> Bool
Set.null Set SockAddr
ks
        let xs :: [SockAddr]
xs = Set SockAddr -> [SockAddr]
forall a. Set a -> [a]
Set.toList Set SockAddr
ks
        Int
a <- IO Int -> MaybeT m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> MaybeT m Int) -> IO Int -> MaybeT m Int
forall a b. (a -> b) -> a -> b
$ CharPos -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (0, [SockAddr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SockAddr]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
        let p :: SockAddr
p = [SockAddr]
xs [SockAddr] -> Int -> SockAddr
forall a. [a] -> Int -> a
!! Int
a
        TVar [OnlinePeer]
o <- (PeerManager -> TVar [OnlinePeer]) -> MaybeT m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
        Maybe OnlinePeer
m <- STM (Maybe OnlinePeer) -> MaybeT m (Maybe OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe OnlinePeer) -> MaybeT m (Maybe OnlinePeer))
-> STM (Maybe OnlinePeer) -> MaybeT m (Maybe OnlinePeer)
forall a b. (a -> b) -> a -> b
$ do
            TVar (Set SockAddr) -> (Set SockAddr -> Set SockAddr) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Set SockAddr)
b ((Set SockAddr -> Set SockAddr) -> STM ())
-> (Set SockAddr -> Set SockAddr) -> STM ()
forall a b. (a -> b) -> a -> b
$ SockAddr -> Set SockAddr -> Set SockAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete SockAddr
p
            TVar [OnlinePeer] -> SockAddr -> STM (Maybe OnlinePeer)
findPeerAddress TVar [OnlinePeer]
o SockAddr
p
        MaybeT m SockAddr
-> (OnlinePeer -> MaybeT m SockAddr)
-> Maybe OnlinePeer
-> MaybeT m SockAddr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SockAddr -> MaybeT m SockAddr
forall (m :: * -> *) a. Monad m => a -> m a
return SockAddr
p) (MaybeT m SockAddr -> OnlinePeer -> MaybeT m SockAddr
forall a b. a -> b -> a
const MaybeT m SockAddr
go) Maybe OnlinePeer
m


connectPeer :: ( MonadUnliftIO m
               , MonadManager m
               , MonadLoggerIO m
               )
            => SockAddr
            -> m ()
connectPeer :: SockAddr -> m ()
connectPeer sa :: SockAddr
sa = do
    TVar [OnlinePeer]
os <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    STM (Maybe OnlinePeer) -> m (Maybe OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar [OnlinePeer] -> SockAddr -> STM (Maybe OnlinePeer)
findPeerAddress TVar [OnlinePeer]
os SockAddr
sa) m (Maybe OnlinePeer) -> (Maybe OnlinePeer -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just _ ->
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            "Attempted to connect to peer twice: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (SockAddr -> String
forall a. Show a => a -> String
show SockAddr
sa)
        Nothing -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logInfoS) "PeerManager" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Connecting to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (SockAddr -> String
forall a. Show a => a -> String
show SockAddr
sa)
            PeerManagerConfig { peerManagerNetAddr :: PeerManagerConfig -> NetworkAddress
peerManagerNetAddr = NetworkAddress
ad
                              , peerManagerNetwork :: PeerManagerConfig -> Network
peerManagerNetwork = Network
net
                              } <- (PeerManager -> PeerManagerConfig) -> m PeerManagerConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> PeerManagerConfig
myConfig
            Supervisor
sup <- (PeerManager -> Supervisor) -> m Supervisor
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> Supervisor
mySupervisor
            SockAddr -> WithConnection
conn <- (PeerManager -> SockAddr -> WithConnection)
-> m (SockAddr -> WithConnection)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> SockAddr -> WithConnection
peerManagerConnect (PeerManagerConfig -> SockAddr -> WithConnection)
-> (PeerManager -> PeerManagerConfig)
-> PeerManager
-> SockAddr
-> WithConnection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)
            Publisher (Peer, Message)
pub <- (PeerManager -> Publisher (Peer, Message))
-> m (Publisher (Peer, Message))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> Publisher (Peer, Message)
peerManagerPub (PeerManagerConfig -> Publisher (Peer, Message))
-> (PeerManager -> PeerManagerConfig)
-> PeerManager
-> Publisher (Peer, Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)
            Word64
nonce <- IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
            BlockHeight
bb <- m BlockHeight
forall (m :: * -> *). MonadManager m => m BlockHeight
getBestBlock
            UTCTime
now <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            let rmt :: NetworkAddress
rmt = Word64 -> HostAddress -> NetworkAddress
NetworkAddress (Network -> Word64
forall p. Num p => Network -> p
srv Network
net) (SockAddr -> HostAddress
sockToHostAddress SockAddr
sa)
                unix :: Word64
unix = NominalDiffTime -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
now)
                ver :: Version
ver = Network
-> Word64
-> BlockHeight
-> NetworkAddress
-> NetworkAddress
-> Word64
-> Version
buildVersion Network
net Word64
nonce BlockHeight
bb NetworkAddress
ad NetworkAddress
rmt Word64
unix
                text :: Text
text = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (SockAddr -> String
forall a. Show a => a -> String
show SockAddr
sa)
            (inbox :: Inbox PeerMessage
inbox, mailbox :: Mailbox PeerMessage
mailbox) <- m (Inbox PeerMessage, Mailbox PeerMessage)
forall (m :: * -> *) msg.
MonadUnliftIO m =>
m (Inbox msg, Mailbox msg)
newMailbox
            let pc :: PeerConfig
pc = $WPeerConfig :: Publisher (Peer, Message)
-> Network -> Text -> WithConnection -> PeerConfig
PeerConfig { peerConfPub :: Publisher (Peer, Message)
peerConfPub = Publisher (Peer, Message)
pub
                                , peerConfNetwork :: Network
peerConfNetwork = Network
net
                                , peerConfText :: Text
peerConfText = Text
text
                                , peerConfConnect :: WithConnection
peerConfConnect = SockAddr -> WithConnection
conn SockAddr
sa
                                }
            TVar Bool
busy <- Bool -> m (TVar Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Bool
False
            Peer
p <- PeerConfig -> TVar Bool -> Mailbox PeerMessage -> m Peer
forall (m :: * -> *).
MonadIO m =>
PeerConfig -> TVar Bool -> Mailbox PeerMessage -> m Peer
wrapPeer PeerConfig
pc TVar Bool
busy Mailbox PeerMessage
mailbox
            Async ()
a <- ((forall a. m a -> IO a) -> IO (Async ())) -> m (Async ())
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Async ())) -> m (Async ()))
-> ((forall a. m a -> IO a) -> IO (Async ())) -> m (Async ())
forall a b. (a -> b) -> a -> b
$ \io :: forall a. m a -> IO a
io ->
                Supervisor
sup Supervisor -> ChildAction -> IO (Async ())
forall (m :: * -> *).
MonadIO m =>
Supervisor -> ChildAction -> m (Async ())
`addChild` m () -> ChildAction
forall a. m a -> IO a
io (PeerConfig -> TVar Bool -> Inbox PeerMessage -> Peer -> m ()
forall (m :: * -> *).
(MonadReader PeerManager m, MonadUnliftIO m, MonadLoggerIO m) =>
PeerConfig -> TVar Bool -> Inbox PeerMessage -> Peer -> m ()
launch PeerConfig
pc TVar Bool
busy Inbox PeerMessage
inbox Peer
p)
            Version -> Message
MVersion Version
ver Message -> Peer -> m ()
forall (m :: * -> *). MonadIO m => Message -> Peer -> m ()
`sendMessage` Peer
p
            TVar [OnlinePeer]
b <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
            NominalDiffTime
max_life <- (PeerManager -> NominalDiffTime) -> m NominalDiffTime
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> NominalDiffTime
peerManagerMaxLife (PeerManagerConfig -> NominalDiffTime)
-> (PeerManager -> PeerManagerConfig)
-> PeerManager
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)
            Rational
rand <- IO Rational -> m Rational
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rational -> m Rational) -> IO Rational -> m Rational
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Rational) -> IO Double -> IO Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double, Double) -> IO Double
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (0.75 :: Double, 1.00)
            let life :: NominalDiffTime
life = NominalDiffTime
max_life NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational Rational
rand
            let dc :: UTCTime
dc = NominalDiffTime
life NominalDiffTime -> UTCTime -> UTCTime
`addUTCTime` UTCTime
now
            OnlinePeer
_ <- STM OnlinePeer -> m OnlinePeer
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM OnlinePeer -> m OnlinePeer) -> STM OnlinePeer -> m OnlinePeer
forall a b. (a -> b) -> a -> b
$ TVar [OnlinePeer]
-> SockAddr
-> Word64
-> Peer
-> Async ()
-> UTCTime
-> UTCTime
-> STM OnlinePeer
newOnlinePeer TVar [OnlinePeer]
b SockAddr
sa Word64
nonce Peer
p Async ()
a UTCTime
now UTCTime
dc
            () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    srv :: Network -> p
srv net :: Network
net
        | Network -> Bool
getSegWit Network
net = 8
        | Bool
otherwise = 0
    launch :: PeerConfig -> TVar Bool -> Inbox PeerMessage -> Peer -> m ()
launch pc :: PeerConfig
pc busy :: TVar Bool
busy inbox :: Inbox PeerMessage
inbox p :: Peer
p =
        m PeerManager
forall r (m :: * -> *). MonadReader r m => m r
ask m PeerManager -> (PeerManager -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \mgr :: PeerManager
mgr ->
        SockAddr -> Peer -> PeerManager -> (Async () -> m ()) -> m ()
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
SockAddr -> Peer -> PeerManager -> (Async a -> m a) -> m a
withPeerLoop SockAddr
sa Peer
p PeerManager
mgr ((Async () -> m ()) -> m ()) -> (Async () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a :: Async ()
a ->
        Async () -> m ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
link Async ()
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PeerConfig -> TVar Bool -> Inbox PeerMessage -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
PeerConfig -> TVar Bool -> Inbox PeerMessage -> m ()
peer PeerConfig
pc TVar Bool
busy Inbox PeerMessage
inbox

withPeerLoop ::
       (MonadUnliftIO m, MonadLogger m)
    => SockAddr
    -> Peer
    -> PeerManager
    -> (Async a -> m a)
    -> m a
withPeerLoop :: SockAddr -> Peer -> PeerManager -> (Async a -> m a) -> m a
withPeerLoop _ p :: Peer
p mgr :: PeerManager
mgr =
    m a -> (Async a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (m a -> (Async a -> m a) -> m a)
-> (m () -> m a) -> m () -> (Async a -> m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> (Async a -> m a) -> m a)
-> m () -> (Async a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ do
        let x :: NominalDiffTime
x = PeerManagerConfig -> NominalDiffTime
peerManagerTimeout (PeerManager -> PeerManagerConfig
myConfig PeerManager
mgr)
            y :: Int
y = NominalDiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime
x NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* 1000000)
        Int
r <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ CharPos -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 4, Int
y)
        Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
r
        Peer -> PeerManager -> m ()
forall (m :: * -> *). MonadIO m => Peer -> PeerManager -> m ()
managerCheck Peer
p PeerManager
mgr

withConnectLoop :: (MonadUnliftIO m, MonadManager m)
                => m a
                -> m a
withConnectLoop :: m a -> m a
withConnectLoop act :: m a
act =
    m Any -> (Async Any -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync m Any
forall b. m b
go ((Async Any -> m a) -> m a) -> (Async Any -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a :: Async Any
a ->
    Async Any -> m ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
link Async Any
a m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
act
  where
    go :: m b
go = m () -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m b) -> m () -> m b
forall a b. (a -> b) -> a -> b
$ do
        Int
l <- [OnlinePeer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([OnlinePeer] -> Int) -> m [OnlinePeer] -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [OnlinePeer]
forall (m :: * -> *). MonadManager m => m [OnlinePeer]
getOnlinePeers
        Int
x <- (PeerManager -> Int) -> m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PeerManagerConfig -> Int
peerManagerMaxPeers (PeerManagerConfig -> Int)
-> (PeerManager -> PeerManagerConfig) -> PeerManager -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerManager -> PeerManagerConfig
myConfig)
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            m (Maybe SockAddr)
forall (m :: * -> *).
(MonadUnliftIO m, MonadManager m) =>
m (Maybe SockAddr)
getNewPeer m (Maybe SockAddr) -> (Maybe SockAddr -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SockAddr -> m ()) -> Maybe SockAddr -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\sa :: SockAddr
sa -> m PeerManager
forall r (m :: * -> *). MonadReader r m => m r
ask m PeerManager -> (PeerManager -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SockAddr -> PeerManager -> m ()
forall (m :: * -> *). MonadIO m => SockAddr -> PeerManager -> m ()
managerConnect SockAddr
sa)
        Int
delay <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$
            CharPos -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO ( 100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000
                      , 10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 500 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000 )
        Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
delay

newPeer :: (MonadIO m, MonadManager m) => SockAddr -> m ()
newPeer :: SockAddr -> m ()
newPeer sa :: SockAddr
sa = do
    TVar (Set SockAddr)
b <- (PeerManager -> TVar (Set SockAddr)) -> m (TVar (Set SockAddr))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar (Set SockAddr)
knownPeers
    TVar [OnlinePeer]
o <- (PeerManager -> TVar [OnlinePeer]) -> m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers
    STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$
        TVar [OnlinePeer] -> SockAddr -> STM (Maybe OnlinePeer)
findPeerAddress TVar [OnlinePeer]
o SockAddr
sa STM (Maybe OnlinePeer) -> (Maybe OnlinePeer -> STM ()) -> STM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just _  -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Nothing -> TVar (Set SockAddr) -> (Set SockAddr -> Set SockAddr) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Set SockAddr)
b ((Set SockAddr -> Set SockAddr) -> STM ())
-> (Set SockAddr -> Set SockAddr) -> STM ()
forall a b. (a -> b) -> a -> b
$ SockAddr -> Set SockAddr -> Set SockAddr
forall a. Ord a => a -> Set a -> Set a
Set.insert SockAddr
sa

networkSeeds :: Network -> [HostPort]
networkSeeds :: Network -> [HostPort]
networkSeeds net :: Network
net = (String -> HostPort) -> [String] -> [HostPort]
forall a b. (a -> b) -> [a] -> [b]
map (, Network -> Int
getDefaultPort Network
net) (Network -> [String]
getSeeds Network
net)

gotPong :: TVar [OnlinePeer] -> Word64 -> UTCTime -> Peer -> STM ()
gotPong :: TVar [OnlinePeer] -> Word64 -> UTCTime -> Peer -> STM ()
gotPong b :: TVar [OnlinePeer]
b nonce :: Word64
nonce now :: UTCTime
now p :: Peer
p = STM (Maybe ()) -> STM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (STM (Maybe ()) -> STM ())
-> (MaybeT STM () -> STM (Maybe ())) -> MaybeT STM () -> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT STM () -> STM (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT STM () -> STM ()) -> MaybeT STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
    OnlinePeer
o <- STM (Maybe OnlinePeer) -> MaybeT STM OnlinePeer
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (STM (Maybe OnlinePeer) -> MaybeT STM OnlinePeer)
-> STM (Maybe OnlinePeer) -> MaybeT STM OnlinePeer
forall a b. (a -> b) -> a -> b
$ TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer TVar [OnlinePeer]
b Peer
p
    (time :: UTCTime
time, old_nonce :: Word64
old_nonce) <- STM (Maybe (UTCTime, Word64)) -> MaybeT STM (UTCTime, Word64)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (STM (Maybe (UTCTime, Word64)) -> MaybeT STM (UTCTime, Word64))
-> (Maybe (UTCTime, Word64) -> STM (Maybe (UTCTime, Word64)))
-> Maybe (UTCTime, Word64)
-> MaybeT STM (UTCTime, Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (UTCTime, Word64) -> STM (Maybe (UTCTime, Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (UTCTime, Word64) -> MaybeT STM (UTCTime, Word64))
-> Maybe (UTCTime, Word64) -> MaybeT STM (UTCTime, Word64)
forall a b. (a -> b) -> a -> b
$ OnlinePeer -> Maybe (UTCTime, Word64)
onlinePeerPing OnlinePeer
o
    Bool -> MaybeT STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT STM ()) -> Bool -> MaybeT STM ()
forall a b. (a -> b) -> a -> b
$ Word64
nonce Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
old_nonce
    let diff :: NominalDiffTime
diff = UTCTime
now UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
time
    STM () -> MaybeT STM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM () -> MaybeT STM ()) -> STM () -> MaybeT STM ()
forall a b. (a -> b) -> a -> b
$
        TVar [OnlinePeer] -> OnlinePeer -> STM ()
insertPeer
            TVar [OnlinePeer]
b
            OnlinePeer
o { onlinePeerPing :: Maybe (UTCTime, Word64)
onlinePeerPing = Maybe (UTCTime, Word64)
forall a. Maybe a
Nothing
              , onlinePeerPings :: [NominalDiffTime]
onlinePeerPings = [NominalDiffTime] -> [NominalDiffTime]
forall a. Ord a => [a] -> [a]
sort ([NominalDiffTime] -> [NominalDiffTime])
-> [NominalDiffTime] -> [NominalDiffTime]
forall a b. (a -> b) -> a -> b
$ Int -> [NominalDiffTime] -> [NominalDiffTime]
forall a. Int -> [a] -> [a]
take 11 ([NominalDiffTime] -> [NominalDiffTime])
-> [NominalDiffTime] -> [NominalDiffTime]
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
diff NominalDiffTime -> [NominalDiffTime] -> [NominalDiffTime]
forall a. a -> [a] -> [a]
: OnlinePeer -> [NominalDiffTime]
onlinePeerPings OnlinePeer
o
              }

setPeerPing :: TVar [OnlinePeer] -> Word64 -> UTCTime -> Peer -> STM ()
setPeerPing :: TVar [OnlinePeer] -> Word64 -> UTCTime -> Peer -> STM ()
setPeerPing b :: TVar [OnlinePeer]
b nonce :: Word64
nonce now :: UTCTime
now p :: Peer
p =
    TVar [OnlinePeer] -> Peer -> (OnlinePeer -> OnlinePeer) -> STM ()
modifyPeer TVar [OnlinePeer]
b Peer
p ((OnlinePeer -> OnlinePeer) -> STM ())
-> (OnlinePeer -> OnlinePeer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \o :: OnlinePeer
o -> OnlinePeer
o {onlinePeerPing :: Maybe (UTCTime, Word64)
onlinePeerPing = (UTCTime, Word64) -> Maybe (UTCTime, Word64)
forall a. a -> Maybe a
Just (UTCTime
now, Word64
nonce)}

setPeerVersion ::
       TVar [OnlinePeer]
    -> Peer
    -> Version
    -> STM (Either PeerException OnlinePeer)
setPeerVersion :: TVar [OnlinePeer]
-> Peer -> Version -> STM (Either PeerException OnlinePeer)
setPeerVersion b :: TVar [OnlinePeer]
b p :: Peer
p v :: Version
v = ExceptT PeerException STM OnlinePeer
-> STM (Either PeerException OnlinePeer)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PeerException STM OnlinePeer
 -> STM (Either PeerException OnlinePeer))
-> ExceptT PeerException STM OnlinePeer
-> STM (Either PeerException OnlinePeer)
forall a b. (a -> b) -> a -> b
$ do
    Bool
-> ExceptT PeerException STM () -> ExceptT PeerException STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Word64
services Version
v Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
nodeNetwork Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (ExceptT PeerException STM () -> ExceptT PeerException STM ())
-> ExceptT PeerException STM () -> ExceptT PeerException STM ()
forall a b. (a -> b) -> a -> b
$
        PeerException -> ExceptT PeerException STM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PeerException
NotNetworkPeer
    [OnlinePeer]
ops <- STM [OnlinePeer] -> ExceptT PeerException STM [OnlinePeer]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM [OnlinePeer] -> ExceptT PeerException STM [OnlinePeer])
-> STM [OnlinePeer] -> ExceptT PeerException STM [OnlinePeer]
forall a b. (a -> b) -> a -> b
$ TVar [OnlinePeer] -> STM [OnlinePeer]
forall a. TVar a -> STM a
readTVar TVar [OnlinePeer]
b
    Bool
-> ExceptT PeerException STM () -> ExceptT PeerException STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((OnlinePeer -> Bool) -> [OnlinePeer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Version -> Word64
verNonce Version
v Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==) (Word64 -> Bool) -> (OnlinePeer -> Word64) -> OnlinePeer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnlinePeer -> Word64
onlinePeerNonce) [OnlinePeer]
ops) (ExceptT PeerException STM () -> ExceptT PeerException STM ())
-> ExceptT PeerException STM () -> ExceptT PeerException STM ()
forall a b. (a -> b) -> a -> b
$
        PeerException -> ExceptT PeerException STM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PeerException
PeerIsMyself
    STM (Maybe OnlinePeer)
-> ExceptT PeerException STM (Maybe OnlinePeer)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer TVar [OnlinePeer]
b Peer
p) ExceptT PeerException STM (Maybe OnlinePeer)
-> (Maybe OnlinePeer -> ExceptT PeerException STM OnlinePeer)
-> ExceptT PeerException STM OnlinePeer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing -> PeerException -> ExceptT PeerException STM OnlinePeer
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PeerException
UnknownPeer
        Just o :: OnlinePeer
o -> do
            let n :: OnlinePeer
n = OnlinePeer
o { onlinePeerVersion :: Maybe Version
onlinePeerVersion = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
                      , onlinePeerConnected :: Bool
onlinePeerConnected = OnlinePeer -> Bool
onlinePeerVerAck OnlinePeer
o }
            STM () -> ExceptT PeerException STM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM () -> ExceptT PeerException STM ())
-> STM () -> ExceptT PeerException STM ()
forall a b. (a -> b) -> a -> b
$ TVar [OnlinePeer] -> OnlinePeer -> STM ()
insertPeer TVar [OnlinePeer]
b OnlinePeer
n
            OnlinePeer -> ExceptT PeerException STM OnlinePeer
forall (m :: * -> *) a. Monad m => a -> m a
return OnlinePeer
n

setPeerVerAck :: TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
setPeerVerAck :: TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
setPeerVerAck b :: TVar [OnlinePeer]
b p :: Peer
p = MaybeT STM OnlinePeer -> STM (Maybe OnlinePeer)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT STM OnlinePeer -> STM (Maybe OnlinePeer))
-> MaybeT STM OnlinePeer -> STM (Maybe OnlinePeer)
forall a b. (a -> b) -> a -> b
$ do
    OnlinePeer
o <- STM (Maybe OnlinePeer) -> MaybeT STM OnlinePeer
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (STM (Maybe OnlinePeer) -> MaybeT STM OnlinePeer)
-> STM (Maybe OnlinePeer) -> MaybeT STM OnlinePeer
forall a b. (a -> b) -> a -> b
$ TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer TVar [OnlinePeer]
b Peer
p
    let n :: OnlinePeer
n = OnlinePeer
o { onlinePeerVerAck :: Bool
onlinePeerVerAck = Bool
True
              , onlinePeerConnected :: Bool
onlinePeerConnected = Maybe Version -> Bool
forall a. Maybe a -> Bool
isJust (OnlinePeer -> Maybe Version
onlinePeerVersion OnlinePeer
o) }
    STM () -> MaybeT STM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM () -> MaybeT STM ()) -> STM () -> MaybeT STM ()
forall a b. (a -> b) -> a -> b
$ TVar [OnlinePeer] -> OnlinePeer -> STM ()
insertPeer TVar [OnlinePeer]
b OnlinePeer
n
    OnlinePeer -> MaybeT STM OnlinePeer
forall (m :: * -> *) a. Monad m => a -> m a
return OnlinePeer
n

newOnlinePeer ::
       TVar [OnlinePeer]
    -> SockAddr
    -> Word64
    -> Peer
    -> Async ()
    -> UTCTime
    -> UTCTime
    -> STM OnlinePeer
newOnlinePeer :: TVar [OnlinePeer]
-> SockAddr
-> Word64
-> Peer
-> Async ()
-> UTCTime
-> UTCTime
-> STM OnlinePeer
newOnlinePeer box :: TVar [OnlinePeer]
box addr :: SockAddr
addr nonce :: Word64
nonce p :: Peer
p peer_async :: Async ()
peer_async connect_time :: UTCTime
connect_time dc :: UTCTime
dc = do
    let op :: OnlinePeer
op = $WOnlinePeer :: SockAddr
-> Bool
-> Bool
-> Maybe Version
-> Async ()
-> Peer
-> Word64
-> Maybe (UTCTime, Word64)
-> [NominalDiffTime]
-> UTCTime
-> UTCTime
-> UTCTime
-> OnlinePeer
OnlinePeer
             { onlinePeerAddress :: SockAddr
onlinePeerAddress = SockAddr
addr
             , onlinePeerVerAck :: Bool
onlinePeerVerAck = Bool
False
             , onlinePeerConnected :: Bool
onlinePeerConnected = Bool
False
             , onlinePeerVersion :: Maybe Version
onlinePeerVersion = Maybe Version
forall a. Maybe a
Nothing
             , onlinePeerAsync :: Async ()
onlinePeerAsync = Async ()
peer_async
             , onlinePeerMailbox :: Peer
onlinePeerMailbox = Peer
p
             , onlinePeerNonce :: Word64
onlinePeerNonce = Word64
nonce
             , onlinePeerPings :: [NominalDiffTime]
onlinePeerPings = []
             , onlinePeerPing :: Maybe (UTCTime, Word64)
onlinePeerPing = Maybe (UTCTime, Word64)
forall a. Maybe a
Nothing
             , onlinePeerConnectTime :: UTCTime
onlinePeerConnectTime = UTCTime
connect_time
             , onlinePeerTickled :: UTCTime
onlinePeerTickled = UTCTime
connect_time
             , onlinePeerDisconnect :: UTCTime
onlinePeerDisconnect = UTCTime
dc
             }
    TVar [OnlinePeer] -> OnlinePeer -> STM ()
insertPeer TVar [OnlinePeer]
box OnlinePeer
op
    OnlinePeer -> STM OnlinePeer
forall (m :: * -> *) a. Monad m => a -> m a
return OnlinePeer
op

findPeer :: TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer :: TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer b :: TVar [OnlinePeer]
b p :: Peer
p =
    (OnlinePeer -> Bool) -> [OnlinePeer] -> Maybe OnlinePeer
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Peer -> Peer -> Bool
forall a. Eq a => a -> a -> Bool
== Peer
p) (Peer -> Bool) -> (OnlinePeer -> Peer) -> OnlinePeer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnlinePeer -> Peer
onlinePeerMailbox)
    ([OnlinePeer] -> Maybe OnlinePeer)
-> STM [OnlinePeer] -> STM (Maybe OnlinePeer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [OnlinePeer] -> STM [OnlinePeer]
forall a. TVar a -> STM a
readTVar TVar [OnlinePeer]
b

insertPeer :: TVar [OnlinePeer] -> OnlinePeer -> STM ()
insertPeer :: TVar [OnlinePeer] -> OnlinePeer -> STM ()
insertPeer b :: TVar [OnlinePeer]
b o :: OnlinePeer
o =
    TVar [OnlinePeer] -> ([OnlinePeer] -> [OnlinePeer]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar [OnlinePeer]
b (([OnlinePeer] -> [OnlinePeer]) -> STM ())
-> ([OnlinePeer] -> [OnlinePeer]) -> STM ()
forall a b. (a -> b) -> a -> b
$ \x :: [OnlinePeer]
x -> [OnlinePeer] -> [OnlinePeer]
forall a. Ord a => [a] -> [a]
sort ([OnlinePeer] -> [OnlinePeer])
-> ([OnlinePeer] -> [OnlinePeer]) -> [OnlinePeer] -> [OnlinePeer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OnlinePeer] -> [OnlinePeer]
forall a. Eq a => [a] -> [a]
nub ([OnlinePeer] -> [OnlinePeer]) -> [OnlinePeer] -> [OnlinePeer]
forall a b. (a -> b) -> a -> b
$ OnlinePeer
o OnlinePeer -> [OnlinePeer] -> [OnlinePeer]
forall a. a -> [a] -> [a]
: [OnlinePeer]
x

modifyPeer :: TVar [OnlinePeer]
           -> Peer
           -> (OnlinePeer -> OnlinePeer)
           -> STM ()
modifyPeer :: TVar [OnlinePeer] -> Peer -> (OnlinePeer -> OnlinePeer) -> STM ()
modifyPeer b :: TVar [OnlinePeer]
b p :: Peer
p f :: OnlinePeer -> OnlinePeer
f =
    TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
findPeer TVar [OnlinePeer]
b Peer
p STM (Maybe OnlinePeer) -> (Maybe OnlinePeer -> STM ()) -> STM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just o :: OnlinePeer
o  -> TVar [OnlinePeer] -> OnlinePeer -> STM ()
insertPeer TVar [OnlinePeer]
b (OnlinePeer -> STM ()) -> OnlinePeer -> STM ()
forall a b. (a -> b) -> a -> b
$ OnlinePeer -> OnlinePeer
f OnlinePeer
o

removePeer :: TVar [OnlinePeer] -> Peer -> STM ()
removePeer :: TVar [OnlinePeer] -> Peer -> STM ()
removePeer b :: TVar [OnlinePeer]
b p :: Peer
p =
    TVar [OnlinePeer] -> ([OnlinePeer] -> [OnlinePeer]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar [OnlinePeer]
b (([OnlinePeer] -> [OnlinePeer]) -> STM ())
-> ([OnlinePeer] -> [OnlinePeer]) -> STM ()
forall a b. (a -> b) -> a -> b
$
    (OnlinePeer -> Bool) -> [OnlinePeer] -> [OnlinePeer]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Peer -> Peer -> Bool
forall a. Eq a => a -> a -> Bool
/= Peer
p) (Peer -> Bool) -> (OnlinePeer -> Peer) -> OnlinePeer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnlinePeer -> Peer
onlinePeerMailbox)

findPeerAsync :: TVar [OnlinePeer]
              -> Async ()
              -> STM (Maybe OnlinePeer)
findPeerAsync :: TVar [OnlinePeer] -> Async () -> STM (Maybe OnlinePeer)
findPeerAsync b :: TVar [OnlinePeer]
b a :: Async ()
a =
    (OnlinePeer -> Bool) -> [OnlinePeer] -> Maybe OnlinePeer
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Async () -> Async () -> Bool
forall a. Eq a => a -> a -> Bool
== Async ()
a) (Async () -> Bool)
-> (OnlinePeer -> Async ()) -> OnlinePeer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnlinePeer -> Async ()
onlinePeerAsync)
    ([OnlinePeer] -> Maybe OnlinePeer)
-> STM [OnlinePeer] -> STM (Maybe OnlinePeer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [OnlinePeer] -> STM [OnlinePeer]
forall a. TVar a -> STM a
readTVar TVar [OnlinePeer]
b

findPeerAddress :: TVar [OnlinePeer]
                -> SockAddr
                -> STM (Maybe OnlinePeer)
findPeerAddress :: TVar [OnlinePeer] -> SockAddr -> STM (Maybe OnlinePeer)
findPeerAddress b :: TVar [OnlinePeer]
b a :: SockAddr
a =
    (OnlinePeer -> Bool) -> [OnlinePeer] -> Maybe OnlinePeer
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((SockAddr -> SockAddr -> Bool
forall a. Eq a => a -> a -> Bool
== SockAddr
a) (SockAddr -> Bool)
-> (OnlinePeer -> SockAddr) -> OnlinePeer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnlinePeer -> SockAddr
onlinePeerAddress)
    ([OnlinePeer] -> Maybe OnlinePeer)
-> STM [OnlinePeer] -> STM (Maybe OnlinePeer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [OnlinePeer] -> STM [OnlinePeer]
forall a. TVar a -> STM a
readTVar TVar [OnlinePeer]
b

getPeers :: MonadIO m => PeerManager -> m [OnlinePeer]
getPeers :: PeerManager -> m [OnlinePeer]
getPeers = ReaderT PeerManager m [OnlinePeer] -> PeerManager -> m [OnlinePeer]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT PeerManager m [OnlinePeer]
forall (m :: * -> *). MonadManager m => m [OnlinePeer]
getConnectedPeers

getOnlinePeer :: MonadIO m
              => Peer
              -> PeerManager
              -> m (Maybe OnlinePeer)
getOnlinePeer :: Peer -> PeerManager -> m (Maybe OnlinePeer)
getOnlinePeer p :: Peer
p =
    ReaderT PeerManager m (Maybe OnlinePeer)
-> PeerManager -> m (Maybe OnlinePeer)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT PeerManager m (Maybe OnlinePeer)
 -> PeerManager -> m (Maybe OnlinePeer))
-> ReaderT PeerManager m (Maybe OnlinePeer)
-> PeerManager
-> m (Maybe OnlinePeer)
forall a b. (a -> b) -> a -> b
$ (PeerManager -> TVar [OnlinePeer])
-> ReaderT PeerManager m (TVar [OnlinePeer])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PeerManager -> TVar [OnlinePeer]
onlinePeers ReaderT PeerManager m (TVar [OnlinePeer])
-> (TVar [OnlinePeer] -> ReaderT PeerManager m (Maybe OnlinePeer))
-> ReaderT PeerManager m (Maybe OnlinePeer)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM (Maybe OnlinePeer) -> ReaderT PeerManager m (Maybe OnlinePeer)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe OnlinePeer)
 -> ReaderT PeerManager m (Maybe OnlinePeer))
-> (TVar [OnlinePeer] -> STM (Maybe OnlinePeer))
-> TVar [OnlinePeer]
-> ReaderT PeerManager m (Maybe OnlinePeer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar [OnlinePeer] -> Peer -> STM (Maybe OnlinePeer)
`findPeer` Peer
p)

managerCheck :: MonadIO m => Peer -> PeerManager -> m ()
managerCheck :: Peer -> PeerManager -> m ()
managerCheck p :: Peer
p mgr :: PeerManager
mgr =
    Peer -> ManagerMessage
CheckPeer Peer
p ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

managerConnect :: MonadIO m => SockAddr -> PeerManager -> m ()
managerConnect :: SockAddr -> PeerManager -> m ()
managerConnect sa :: SockAddr
sa mgr :: PeerManager
mgr =
    SockAddr -> ManagerMessage
Connect SockAddr
sa ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

managerBest :: MonadIO m => BlockHeight -> PeerManager -> m ()
managerBest :: BlockHeight -> PeerManager -> m ()
managerBest bh :: BlockHeight
bh mgr :: PeerManager
mgr =
    BlockHeight -> ManagerMessage
ManagerBest BlockHeight
bh ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

managerVerAck :: MonadIO m => Peer -> PeerManager -> m ()
managerVerAck :: Peer -> PeerManager -> m ()
managerVerAck p :: Peer
p mgr :: PeerManager
mgr =
    Peer -> ManagerMessage
PeerVerAck Peer
p ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

managerVersion :: MonadIO m
               => Peer -> Version -> PeerManager -> m ()
managerVersion :: Peer -> Version -> PeerManager -> m ()
managerVersion p :: Peer
p ver :: Version
ver mgr :: PeerManager
mgr =
    Peer -> Version -> ManagerMessage
PeerVersion Peer
p Version
ver ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

managerPing :: MonadIO m
            => Peer -> Word64 -> PeerManager -> m ()
managerPing :: Peer -> Word64 -> PeerManager -> m ()
managerPing p :: Peer
p nonce :: Word64
nonce mgr :: PeerManager
mgr =
    Peer -> Word64 -> ManagerMessage
PeerPing Peer
p Word64
nonce ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

managerPong :: MonadIO m
            => Peer -> Word64 -> PeerManager -> m ()
managerPong :: Peer -> Word64 -> PeerManager -> m ()
managerPong p :: Peer
p nonce :: Word64
nonce mgr :: PeerManager
mgr =
    Peer -> Word64 -> ManagerMessage
PeerPong Peer
p Word64
nonce ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

managerAddrs :: MonadIO m
             => Peer -> [NetworkAddress] -> PeerManager -> m ()
managerAddrs :: Peer -> [NetworkAddress] -> PeerManager -> m ()
managerAddrs p :: Peer
p addrs :: [NetworkAddress]
addrs mgr :: PeerManager
mgr =
    Peer -> [NetworkAddress] -> ManagerMessage
PeerAddrs Peer
p [NetworkAddress]
addrs ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

managerTickle :: MonadIO m
              => Peer -> PeerManager -> m ()
managerTickle :: Peer -> PeerManager -> m ()
managerTickle p :: Peer
p mgr :: PeerManager
mgr =
    Peer -> ManagerMessage
PeerTickle Peer
p ManagerMessage -> Mailbox ManagerMessage -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
`send` PeerManager -> Mailbox ManagerMessage
myMailbox PeerManager
mgr

toSockAddr :: MonadUnliftIO m => HostPort -> m [SockAddr]
toSockAddr :: HostPort -> m [SockAddr]
toSockAddr (host :: String
host, port :: Int
port) = m [SockAddr]
go m [SockAddr] -> (SomeException -> m [SockAddr]) -> m [SockAddr]
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> m [SockAddr]
forall (m :: * -> *). Monad m => SomeException -> m [SockAddr]
e
  where
    go :: m [SockAddr]
go =
        ([AddrInfo] -> [SockAddr]) -> m [AddrInfo] -> m [SockAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AddrInfo -> SockAddr) -> [AddrInfo] -> [SockAddr]
forall a b. (a -> b) -> [a] -> [b]
map AddrInfo -> SockAddr
addrAddress) (m [AddrInfo] -> m [SockAddr])
-> (IO [AddrInfo] -> m [AddrInfo]) -> IO [AddrInfo] -> m [SockAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [AddrInfo] -> m [AddrInfo]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AddrInfo] -> m [SockAddr]) -> IO [AddrInfo] -> m [SockAddr]
forall a b. (a -> b) -> a -> b
$
        Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo
            (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just
                 AddrInfo
defaultHints
                 { addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_ADDRCONFIG]
                 , addrSocketType :: SocketType
addrSocketType = SocketType
Stream
                 , addrFamily :: Family
addrFamily = Family
AF_INET
                 })
            (String -> Maybe String
forall a. a -> Maybe a
Just String
host)
            (String -> Maybe String
forall a. a -> Maybe a
Just (Int -> String
forall a. Show a => a -> String
show Int
port))
    e :: Monad m => SomeException -> m [SockAddr]
    e :: SomeException -> m [SockAddr]
e _ = [SockAddr] -> m [SockAddr]
forall (m :: * -> *) a. Monad m => a -> m a
return []

median :: (Ord a, Fractional a) => [a] -> Maybe a
median :: [a] -> Maybe a
median ls :: [a]
ls
    | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ls =
          Maybe a
forall a. Maybe a
Nothing
    | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 =
          a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> ([a] -> a) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Fractional a => a -> a -> a
/ 2) (a -> a) -> ([a] -> a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take 2 ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$
          Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [a]
ls'
    | Bool
otherwise =
          a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> ([a] -> a) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. [a] -> a
head ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$
          Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) [a]
ls'
  where
    ls' :: [a]
ls' = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
ls

buildVersion
    :: Network
    -> Word64
    -> BlockHeight
    -> NetworkAddress
    -> NetworkAddress
    -> Word64
    -> Version
buildVersion :: Network
-> Word64
-> BlockHeight
-> NetworkAddress
-> NetworkAddress
-> Word64
-> Version
buildVersion net :: Network
net nonce :: Word64
nonce height :: BlockHeight
height loc :: NetworkAddress
loc rmt :: NetworkAddress
rmt time :: Word64
time =
    $WVersion :: BlockHeight
-> Word64
-> Word64
-> NetworkAddress
-> NetworkAddress
-> Word64
-> VarString
-> BlockHeight
-> Bool
-> Version
Version
        { version :: BlockHeight
version = BlockHeight
myVersion
        , services :: Word64
services = NetworkAddress -> Word64
naServices NetworkAddress
loc
        , timestamp :: Word64
timestamp = Word64
time
        , addrRecv :: NetworkAddress
addrRecv = NetworkAddress
rmt
        , addrSend :: NetworkAddress
addrSend = NetworkAddress
loc
        , verNonce :: Word64
verNonce = Word64
nonce
        , userAgent :: VarString
userAgent = ByteString -> VarString
VarString (Network -> ByteString
getHaskoinUserAgent Network
net)
        , startHeight :: BlockHeight
startHeight = BlockHeight
height
        , relay :: Bool
relay = Bool
True
        }

myVersion :: Word32
myVersion :: BlockHeight
myVersion = 70012